Initial revision

git-svn-id: https://gcc.gnu.org/svn/gcc/trunk@14772 138bc75d-0d04-0410-961f-82ee72b054a4

371 files changed, 211175 insertions, 0 deletions

diff --git a/gcc/f/BUGS b/gcc/f/BUGS
new file mode 100644
index 00000000000..ebeaedb7b46
--- /dev/null
+++ b/gcc/f/BUGS
@@ -0,0 +1,198 @@
+This file lists known bugs in the GNU Fortran compiler.  Copyright (C)
+1995, 1996 Free Software Foundation, Inc.  You may copy, distribute,
+and modify it freely as long as you preserve this copyright notice and
+permission notice.
+
+Bugs in GNU Fortran
+*******************
+
+   This section identifies bugs that `g77' *users* might run into.
+This includes bugs that are actually in the `gcc' back end (GBE) or in
+`libf2c', because those sets of code are at least somewhat under the
+control of (and necessarily intertwined with) `g77', so it isn't worth
+separating them out.
+
+   For information on bugs that might afflict people who configure,
+port, build, and install `g77', *Note Problems Installing::.
+
+   * Work is needed on the `SIGNAL()' intrinsic to ensure that pointers
+     and integers are properly handled on all targets, including 64-bit
+     machines.
+
+   * When using `-fugly-comma', `g77' assumes an extra `%VAL(0)'
+     argument is to be passed to intrinsics taking no arguments, such
+     as `IARGC()', which in turn reject such a call.  Although this has
+     been worked around for 0.5.18 due to changes in the handling of
+     intrinsics, `g77' needs to do the ugly-argument-appending trick
+     only for external-function invocation, as this would probably be
+     more consistent with compilers that default to using that trick.
+
+   * Something about `g77''s straightforward handling of label
+     references and definitions sometimes prevents the GBE from
+     unrolling loops.  Until this is solved, try inserting or removing
+     `CONTINUE' statements as the terminal statement, using the `END DO'
+     form instead, and so on.  (Probably improved, but not wholly
+     fixed, in 0.5.21.)
+
+   * The `g77' command itself should more faithfully process options
+     the way the `gcc' command does.  For example, `gcc' accepts
+     abbreviated forms of long options, `g77' generally doesn't.
+
+   * Some confusion in diagnostics concerning failing `INCLUDE'
+     statements from within `INCLUDE''d or `#include''d files.
+
+   * `g77' assumes that `INTEGER(KIND=1)' constants range from `-2**31'
+     to `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 `g77' doesn't recognize
+     that, on IEEE-754/854-compliant systems, `0./0.' should produce a
+     NaN and no warning instead of the value `0.' and a warning.  This
+     is to be fixed in version 0.6, when `g77' will use the `gcc' back
+     end's constant-handling mechanisms to replace its own.
+
+   * `g77' uses way too much memory and CPU time to process large
+     aggregate areas having any initialized elements.
+
+     For example, `REAL A(1000000)' followed by `DATA A(1)/1/' takes up
+     way too much time and space, including the size of the generated
+     assembler file.  This is to be mitigated somewhat in version 0.6.
+
+     Version 0.5.18 improves cases like this--specifically, cases of
+     *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
+     `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 `g77' does display a warning message to notify the user
+     before the compiler appears to hang.  *Note Initialization of
+     Large Aggregate Areas: Large Initialization, for information on
+     how to change the point at which `g77' decides to issue this
+     warning.
+
+   * `g77' doesn't emit variable and array members of common blocks for
+     use with a debugger (the `-g' command-line option).  The code is
+     present to do this, but doesn't work with at least one debug
+     format--perhaps it works with others.  And it turns out there's a
+     similar bug for local equivalence areas, so that has been disabled
+     as well.
+
+     As of Version 0.5.19, a temporary kludge solution is provided
+     whereby some rudimentary information on a member is written as a
+     string that is the member's value as a character string.
+
+     *Note Options for Code Generation Conventions: Code Gen Options,
+     for information on the `-fdebug-kludge' option.
+
+   * 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 `MAIN__' (or `MAIN___' or
+     `MAIN_' if `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.
+
+   * Debugging `g77'-compiled code using debuggers other than `gdb' is
+     likely not to work.
+
+     Getting `g77' and `gdb' to work together is a known
+     problem--getting `g77' to work properly with other debuggers, for
+     which source code often is unavailable to `g77' developers, seems
+     like a much larger, unknown problem, and is a lower priority than
+     making `g77' and `gdb' work together properly.
+
+     On the other hand, information about problems other debuggers have
+     with `g77' output might make it easier to properly fix `g77', and
+     perhaps even improve `gdb', so it is definitely welcome.  Such
+     information might even lead to all relevant products working
+     together properly sooner.
+
+   * `g77' currently inserts needless padding for things like `COMMON
+     A,IPAD' where `A' is `CHARACTER*1' and `IPAD' is `INTEGER(KIND=1)'
+     on machines like x86, because the back end insists that `IPAD' be
+     aligned to a 4-byte boundary, but the processor has no such
+     requirement (though it's good for performance).
+
+     It is possible that this is not a real bug, and could be considered
+     a performance feature, but it might be important to provide the
+     ability to Fortran code to specify minimum padding for aggregate
+     areas such as common blocks--and, certainly, there is the
+     potential, with the current setup, for interface differences in
+     the way such areas are laid out between `g77' and other compilers.
+
+   * Some crashes occur when compiling under Solaris on x86 machines.
+
+     Nothing has been heard about any such problems for some time, so
+     this is considering a closed item as of 0.5.20.  Please submit any
+     bug reports pertinent to `g77''s support for Solaris/x86 systems.
+
+   * RS/6000 support is not complete as of the gcc 2.6.3 back end.  The
+     2.7.0 back end appears to fix this problem, or at least mitigate
+     it significantly, but there is at least one known problem that is
+     likely to be a code-generation bug in `gcc-2.7.0' plus
+     `g77-0.5.16'.  This problem shows up only when compiling the
+     Fortran program with `-O'.
+
+     Nothing has been heard about any RS/6000 problems for some time,
+     so this is considering a closed item as of 0.5.20.  Please submit
+     any bug reports pertinent to `g77''s support for RS/6000 systems.
+
+   * SGI support is known to be a bit buggy.  The known problem shows
+     up only when compiling the Fortran program with `-O'.
+
+     It is possible these problems have all been fixed in 0.5.20 by
+     emulating complex arithmetic in the front end.  Please submit any
+     bug reports pertinent to `g77''s support for SGI systems.
+
+   * `g77' doesn't work perfectly on 64-bit configurations such as the
+     Alpha.  This problem is expected to be largely resolved as of
+     version 0.5.20, and further addressed by 0.5.21.  Version 0.6
+     should solve most or all related problems (such as 64-bit machines
+     other than Digital Semiconductor ("DEC") Alphas).
+
+     One known bug that causes a compile-time crash occurs when
+     compiling code such as the following with optimization:
+
+          SUBROUTINE CRASH (TEMP)
+          INTEGER*2 HALF(2)
+          REAL TEMP
+          HALF(1) = NINT (TEMP)
+          END
+
+     It is expected that a future version of `g77' will have a fix for
+     this problem, almost certainly by the time `g77' supports the
+     forthcoming version 2.8.0 of `gcc'.
+
+   * Maintainers of gcc report that the back end definitely has "broken"
+     support for `COMPLEX' types.  Based on their input, it seems many
+     of the problems affect only the more-general facilities for gcc's
+     `__complex__' type, such as `__complex__ int' (where the real and
+     imaginary parts are integers) that GNU Fortran does not use.
+
+     Version 0.5.20 of `g77' works around this problem by not using the
+     back end's support for `COMPLEX'.  The new option
+     `-fno-emulate-complex' avoids the work-around, reverting to using
+     the same "broken" mechanism as that used by versions of `g77'
+     prior to 0.5.20.
+
+   * There seem to be some problems with passing constants, and perhaps
+     general expressions (other than simple variables/arrays), to
+     procedures when compiling on some systems (such as i386) with
+     `-fPIC', as in when compiling for ELF targets.  The symptom is
+     that the assembler complains about invalid opcodes.  More
+     investigation is needed, but the problem is almost certainly in
+     the gcc back end, and it apparently occurs only when compiling
+     sufficiently complicated functions *without* the `-O' option.
+
diff --git a/gcc/f/ChangeLog b/gcc/f/ChangeLog
new file mode 100644
index 00000000000..38546900343
--- /dev/null
+++ b/gcc/f/ChangeLog
@@ -0,0 +1,3721 @@
+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 non-zero 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, which 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/*.
diff --git a/gcc/f/INSTALL b/gcc/f/INSTALL
new file mode 100644
index 00000000000..97423be1498
--- /dev/null
+++ b/gcc/f/INSTALL
@@ -0,0 +1,1517 @@
+This file contains installation information for the GNU Fortran
+compiler.  Copyright (C) 1995, 1996 Free Software Foundation, Inc.  You
+may copy, distribute, and modify it freely as long as you preserve this
+copyright notice and permission notice.
+
+Installing GNU Fortran
+**********************
+
+   The following information describes how to install `g77'.
+
+   The information in this file generally pertains to dealing with
+*source* distributions of `g77' and `gcc'.  It is possible that some of
+this information will be applicable to some *binary* distributions of
+these products--however, since these distributions are not made by the
+maintainers of `g77', responsibility for binary distributions rests with
+whoever built and first distributed them.
+
+   Nevertheless, efforts to make `g77' easier to both build and install
+from source and package up as a binary distribution are ongoing.
+
+Prerequisites
+=============
+
+   The procedures described to unpack, configure, build, and install
+`g77' assume your system has certain programs already installed.
+
+   The following prerequisites should be met by your system before you
+follow the `g77' installation instructions:
+
+`gzip'
+     To unpack the `gcc' and `g77' distributions, you'll need the
+     `gunzip' utility in the `gzip' distribution.  Most UNIX systems
+     already have `gzip' installed.  If yours doesn't, you can get it
+     from the FSF.
+
+     Note that you'll need `tar' and other utilities as well, but all
+     UNIX systems have these.  There are GNU versions of all these
+     available--in fact, a complete GNU UNIX system can be put together
+     on most systems, if desired.
+
+`gcc-2.7.2.2.tar.gz'
+     You need to have this, or some other applicable, version of `gcc'
+     on your system.  The version should be an exact copy of a
+     distribution from the FSF.  It is approximately 7MB large.
+
+     If you've already unpacked `gcc-2.7.2.2.tar.gz' into a directory
+     (named `gcc-2.7.2.2') called the "source tree" for `gcc', you can
+     delete the distribution itself, but you'll need to remember to
+     skip any instructions to unpack this distribution.
+
+     Without an applicable `gcc' source tree, you cannot build `g77'.
+     You can obtain an FSF distribution of `gcc' from the FSF.
+
+`g77-0.5.21.tar.gz'
+     You probably have already unpacked this distribution, or you are
+     reading an advanced copy of this manual, which is contained in
+     this distribution.  This distribution approximately 1MB large.
+
+     You can obtain an FSF distribution of `g77' from the FSF, the same
+     way you obtained `gcc'.
+
+100MB disk space
+     For a complete "bootstrap" build, about 100MB of disk space is
+     required for `g77' by the author's current GNU/Linux system.
+
+     Some juggling can reduce the amount of space needed; during the
+     bootstrap process, once Stage 3 starts, during which the version
+     of `gcc' that has been copied into the `stage2/' directory is used
+     to rebuild the system, you can delete the `stage1/' directory to
+     free up some space.
+
+     It is likely that many systems don't require the complete
+     bootstrap build, as they already have a recent version of `gcc'
+     installed.  Such systems might be able to build `g77' with only
+     about 75MB of free space.
+
+`patch'
+     Although you can do everything `patch' does yourself, by hand,
+     without much trouble, having `patch' installed makes installation
+     of new versions of GNU utilities such as `g77' so much easier that
+     it is worth getting.  You can obtain `patch' the same way you
+     obtained `gcc' and `g77'.
+
+     In any case, you can apply patches by hand--patch files are
+     designed for humans to read them.
+
+`make'
+     Your system must have `make', and you will probably save yourself
+     a lot of trouble if it is GNU `make' (sometimes referred to as
+     `gmake').
+
+`cc'
+     Your system must have a working C compiler.
+
+     *Note Installing GNU CC: (gcc)Installation, for more information
+     on prerequisites for installing `gcc'.
+
+`bison'
+     If you do not have `bison' installed, you can usually work around
+     any need for it, since `g77' itself does not use it, and `gcc'
+     normally includes all files generated by running it in its
+     distribution.  You can obtain `bison' the same way you obtained
+     `gcc' and `g77'.
+
+     *Note Missing bison?::, for information on how to work around not
+     having `bison'.
+
+`makeinfo'
+     If you are missing `makeinfo', you can usually work around any
+     need for it.  You can obtain `makeinfo' the same way you obtained
+     `gcc' and `g77'.
+
+     *Note Missing makeinfo?::, for information on getting around the
+     lack of `makeinfo'.
+
+`root' access
+     To perform the complete installation procedures on a system, you
+     need to have `root' access to that system, or equivalent access.
+
+     Portions of the procedure (such as configuring and building `g77')
+     can be performed by any user with enough disk space and virtual
+     memory.
+
+     However, these instructions are oriented towards less-experienced
+     users who want to install `g77' on their own personal systems.
+
+     System administrators with more experience will want to determine
+     for themselves how they want to modify the procedures described
+     below to suit the needs of their installation.
+
+Problems Installing
+===================
+
+   This is a list of problems (and some apparent problems which don't
+really mean anything is wrong) that show up when configuring, building,
+installing, or porting GNU Fortran.
+
+   *Note Installation Problems: (gcc)Installation Problems, for more
+information on installation problems that can afflict either `gcc' or
+`g77'.
+
+General Problems
+----------------
+
+   These problems can occur on most or all systems.
+
+GNU C Required
+..............
+
+   Compiling `g77' requires GNU C, not just ANSI C.  Fixing this
+wouldn't be very hard (just tedious), but the code using GNU extensions
+to the C language is expected to be rewritten for 0.6 anyway, so there
+are no plans for an interim fix.
+
+   This requirement does not mean you must already have `gcc' installed
+to build `g77'.  As long as you have a working C compiler, you can use a
+bootstrap build to automate the process of first building `gcc' using
+the working C compiler you have, then building `g77' and rebuilding
+`gcc' using that just-built `gcc', and so on.
+
+Patching GNU CC Necessary
+.........................
+
+   `g77' currently requires application of a patch file to the gcc
+compiler tree.  The necessary patches should be folded in to the
+mainline gcc distribution.
+
+   Some combinations of versions of `g77' and `gcc' might actually
+*require* no patches, but the patch files will be provided anyway as
+long as there are more changes expected in subsequent releases.  These
+patch files might contain unnecessary, but possibly helpful, patches.
+As a result, it is possible this issue might never be resolved, except
+by eliminating the need for the person configuring `g77' to apply a
+patch by hand, by going to a more automated approach (such as
+configure-time patching).
+
+Building GNU CC Necessary
+.........................
+
+   It should be possible to build the runtime without building `cc1'
+and other non-Fortran items, but, for now, an easy way to do that is
+not yet established.
+
+Missing strtoul
+...............
+
+   On SunOS4 systems, linking the `f771' program produces an error
+message concerning an undefined symbol named `_strtoul'.
+
+   This is not a `g77' bug.  *Note Patching GNU Fortran::, for
+information on a workaround provided by `g77'.
+
+   The proper fix is either to upgrade your system to one that provides
+a complete ANSI C environment, or improve `gcc' so that it provides one
+for all the languages and configurations it supports.
+
+   *Note:* In earlier versions of `g77', an automated workaround for
+this problem was attempted.  It worked for systems without `_strtoul',
+substituting the incomplete-yet-sufficient version supplied with `g77'
+for those systems.  However, the automated workaround failed
+mysteriously for systems that appeared to have conforming ANSI C
+environments, and it was decided that, lacking resources to more fully
+investigate the problem, it was better to not punish users of those
+systems either by requiring them to work around the problem by hand or
+by always substituting an incomplete `strtoul()' implementation when
+their systems had a complete, working one.  Unfortunately, this meant
+inconveniencing users of systems not having `strtoul()', but they're
+using obsolete (and generally unsupported) systems anyway.
+
+Object File Differences
+.......................
+
+   A comparison of object files after building Stage 3 during a
+bootstrap build will result in `gcc/f/zzz.o' being flagged as different
+from the Stage 2 version.  That is because it contains a string with an
+expansion of the `__TIME__' macro, which expands to the current time of
+day.  It is nothing to worry about, since `gcc/f/zzz.c' doesn't contain
+any actual code.  It does allow you to override its use of `__DATE__'
+and `__TIME__' by defining macros for the compilation--see the source
+code for details.
+
+Cleanup Kills Stage Directories
+...............................
+
+   It'd be helpful if `g77''s `Makefile.in' or `Make-lang.in' would
+create the various `stageN' directories and their subdirectories, so
+developers and expert installers wouldn't have to reconfigure after
+cleaning up.
+
+Missing `gperf'?
+................
+
+   If a build aborts trying to invoke `gperf', that strongly suggests
+an improper method was used to create the `gcc' source directory, such
+as the UNIX `cp -r' command instead of `cp -pr', since this problem
+very likely indicates that the date-time-modified information on the
+`gcc' source files is incorrect.
+
+   The proper solution is to recreate the `gcc' source directory from a
+`gcc' distribution known to be provided by the FSF.
+
+   It is possible you might be able to temporarily work around the
+problem, however, by trying these commands:
+
+     sh# cd gcc
+     sh# touch c-gperf.h
+     sh#
+
+   These commands update the date-time-modified information for the
+file produced by the invocation of `gperf' in the current versions of
+`gcc', so that `make' no longer believes it needs to update it.  This
+file should already exist in a `gcc' distribution, but mistakes made
+when copying the `gcc' directory can leave the modification information
+set such that the `gperf' input files look more "recent" than the
+corresponding output files.
+
+   If the above does not work, definitely start from scratch and avoid
+copying the `gcc' using any method that does not reliably preserve
+date-time-modified information, such as the UNIX `cp -r' command.
+
+Cross-compiler Problems
+-----------------------
+
+   `g77' has been in alpha testing since September of 1992, and in
+public beta testing since February of 1995.  Alpha testing was done by
+a small number of people worldwide on a fairly wide variety of
+machines, involving self-compilation in most or all cases.  Beta
+testing has been done primarily via self-compilation, but in more and
+more cases, cross-compilation (and "criss-cross compilation", where a
+version of a compiler is built on one machine to run on a second and
+generate code that runs on a third) has been tried and has succeeded,
+to varying extents.
+
+   Generally, `g77' can be ported to any configuration to which `gcc',
+`f2c', and `libf2c' can be ported and made to work together, aside from
+the known problems described in this manual.  If you want to port `g77'
+to a particular configuration, you should first make sure `gcc' and
+`libf2c' can be ported to that configuration before focusing on `g77',
+because `g77' is so dependent on them.
+
+   Even for cases where `gcc' and `libf2c' work, you might run into
+problems with cross-compilation on certain machines, for several
+reasons.
+
+   * There is one known bug (a design bug to be fixed in 0.6) that
+     prevents configuration of `g77' as a cross-compiler in some cases,
+     though there are assumptions made during configuration that
+     probably make doing non-self-hosting builds a hassle, requiring
+     manual intervention.
+
+   * `gcc' might still have some trouble being configured for certain
+     combinations of machines.  For example, it might not know how to
+     handle floating-point constants.
+
+   * Improvements to the way `libf2c' is built could make building
+     `g77' as a cross-compiler easier--for example, passing and using
+     `LD' and `AR' in the appropriate ways.
+
+   * There are still some challenges putting together the right
+     run-time libraries (needed by `libf2c') for a target system,
+     depending on the systems involved in the configuration.  (This is
+     a general problem with cross-compilation, and with `gcc' in
+     particular.)
+
+Changing Settings Before Building
+=================================
+
+   Here are some internal `g77' settings that can be changed by editing
+source files in `gcc/f/' before building.
+
+   This information, and perhaps even these settings, represent
+stop-gap solutions to problems people doing various ports of `g77' have
+encountered.  As such, none of the following information is expected to
+be pertinent in future versions of `g77'.
+
+Larger File Unit Numbers
+------------------------
+
+   As distributed, whether as part of `f2c' or `g77', `libf2c' accepts
+file unit numbers only in the range 0 through 99.  For example, a
+statement such as `WRITE (UNIT=100)' causes a run-time crash in
+`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
+`MXUNIT' macro, which represents the maximum unit number, to an
+appropriately higher value.
+
+   To do this, edit the file `f/runtime/libI77/fio.h' in your `g77'
+source tree, changing the following line:
+
+     #define MXUNIT 100
+
+   Change the line so that the value of `MXUNIT' is defined to be at
+least one *greater* than the maximum unit number used by the Fortran
+programs on your system.
+
+   (For example, a program that does `WRITE (UNIT=255)' would require
+`MXUNIT' set to at least 256 to avoid crashing.)
+
+   Then build or rebuild `g77' as appropriate.
+
+   *Note:* Changing this macro has *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 `WRITE (UNIT=100)', but the
+library and operating system underlying `libf2c' might disallow it if
+many other files have already been opened (via `OPEN' or implicitly via
+`READ', `WRITE', and so on).  Information on how to increase these
+other limits should be found in your system's documentation.
+
+Always Flush Output
+-------------------
+
+   Some Fortran programs require output (writes) to be flushed to the
+operating system (under UNIX, via the `fflush()' library call) so that
+errors, such as disk full, are immediately flagged via the relevant
+`ERR=' and `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).
+
+   `libf2c' supports flagging write errors immediately when it is built
+with the `ALWAYS_FLUSH' macro defined.  This results in a `libf2c' 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 `g77' you
+are building, you might wish to modify the `g77' source tree so that
+the version of `libf2c' is built with the `ALWAYS_FLUSH' macro defined,
+enabling this behavior.
+
+   To do this, find this line in `f/runtime/configure.in' in your `g77'
+source tree:
+
+     dnl AC_DEFINE(ALWAYS_FLUSH)
+
+   Remove the leading `dnl ', so the line begins with `AC_DEFINE(', and
+run `autoconf' in that file's directory.  (Or, if you don't have
+`autoconf', you can modify `f2c.h.in' in the same directory to include
+the line `#define ALWAYS_FLUSH' after `#define F2C_INCLUDE'.)
+
+   Then build or rebuild `g77' as appropriate.
+
+Maximum Stackable Size
+----------------------
+
+   `g77', on most machines, puts many variables and arrays on the stack
+where possible, and can be configured (by changing
+`FFECOM_sizeMAXSTACKITEM' in `gcc/f/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).
+
+   *Note:* Putting more variables and arrays on the stack might cause
+problems due to system-dependent limits on stack size.  Also, the value
+of `FFECOM_sizeMAXSTACKITEM' has no effect on automatic variables and
+arrays.  *Note But-bugs::, for more information.
+
+Floating-point Bit Patterns
+---------------------------
+
+   The `g77' build will crash if an attempt is made to build it as a
+cross-compiler for a target when `g77' cannot reliably determine the
+bit pattern of floating-point constants for the target.  Planned
+improvements for g77-0.6 will give it the capabilities it needs to not
+have to crash the build but rather generate correct code for the target.
+(Currently, `g77' would generate bad code under such circumstances if
+it didn't crash during the build, e.g. when compiling a source file
+that does something like `EQUIVALENCE (I,R)' and `DATA R/9.43578/'.)
+
+Initialization of Large Aggregate Areas
+---------------------------------------
+
+   A warning message is issued when `g77' sees code that provides
+initial values (e.g. via `DATA') to an aggregate area (`COMMON' or
+`EQUIVALENCE', or even a large enough array or `CHARACTER' variable)
+that is large enough to increase `g77''s compile time by roughly a
+factor of 10.
+
+   This size currently is quite small, since `g77' currently has a
+known bug requiring too much memory and time to handle such cases.  In
+`gcc/f/data.c', the macro `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 `g77' for the change to take effect.
+
+   Note that, as of version 0.5.18, improvements have reduced the scope
+of the problem for *sparse* initialization of large arrays, especially
+those with large, contiguous uninitialized areas.  However, the warning
+is issued at a point prior to when `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.
+
+Alpha Problems Fixed
+--------------------
+
+   `g77' used to warn when it was used to compile Fortran code for a
+target configuration that is not basically a 32-bit machine (such as an
+Alpha, which is a 64-bit machine, especially if it has a 64-bit
+operating system running on it).  That was because `g77' was known to
+not work properly on such configurations.
+
+   As of version 0.5.20, `g77' is believed to work well enough on such
+systems.  So, the warning is no longer needed or provided.
+
+   However, support for 64-bit systems, especially in areas such as
+cross-compilation and handling of intrinsics, is still incomplete.  The
+symptoms are believed to be compile-time diagnostics rather than the
+generation of bad code.  It is hoped that version 0.6 will completely
+support 64-bit systems.
+
+Quick Start
+===========
+
+   This procedure configures, builds, and installs `g77' "out of the
+box" and works on most UNIX systems.  Each command is identified by a
+unique number, used in the explanatory text that follows.  For the most
+part, the output of each command is not shown, though indications of
+the types of responses are given in a few cases.
+
+   To perform this procedure, the installer must be logged in as user
+`root'.  Much of it can be done while not logged in as `root', and
+users experienced with UNIX administration should be able to modify the
+procedure properly to do so.
+
+   Following traditional UNIX conventions, it is assumed that the
+source trees for `g77' and `gcc' will be placed in `/usr/src'.  It also
+is assumed that the source distributions themselves already reside in
+`/usr/FSF', a naming convention used by the author of `g77' on his own
+system:
+
+     /usr/FSF/gcc-2.7.2.2.tar.gz
+     /usr/FSF/g77-0.5.21.tar.gz
+
+   Users of the following systems should not blindly follow these
+quick-start instructions, because of problems their systems have coping
+with straightforward installation of `g77':
+
+   * SunOS4
+
+   Instead, see *Note Complete Installation::, for detailed information
+on how to configure, build, and install `g77' for your particular
+system.  Also, see *Note Known Causes of Trouble with GNU Fortran:
+Trouble, for information on bugs and other problems known to afflict the
+installation process, and how to report newly discovered ones.
+
+   If your system is *not* on the above list, and *is* a UNIX system or
+one of its variants, you should be able to follow the instructions
+below.  If you vary *any* of the steps below, you might run into
+trouble, including possibly breaking existing programs for other users
+of your system.  Before doing so, it is wise to review the explanations
+of some of the steps.  These explanations follow this list of steps.
+
+     sh[ 1]# cd /usr/src
+     
+     sh[ 2]# gunzip -c < /usr/FSF/gcc-2.7.2.2.tar.gz | tar xf -
+     [Might say "Broken pipe"...that is normal on some systems.]
+     
+     sh[ 3]# gunzip -c < /usr/FSF/g77-0.5.21.tar.gz | tar xf -
+     ["Broken pipe" again possible.]
+     
+     sh[ 4]# ln -s gcc-2.7.2.2 gcc
+     
+     sh[ 5]# ln -s g77-0.5.21 g77
+     
+     sh[ 6]# mv -i g77/* gcc
+     [No questions should be asked by mv here; or, you made a mistake.]
+     
+     sh[ 7]# patch -p1 -V t -d gcc < gcc/f/gbe/2.7.2.2.diff
+     [Unless patch complains about rejected patches, this step worked.]
+     
+     sh[ 8]# cd gcc
+     sh[ 9]# touch f77-install-ok
+     [Do not do the above if your system already has an f77
+     command, unless you've checked that overwriting it
+     is okay.]
+     
+     sh[10]# touch f2c-install-ok
+     [Do not do the above if your system already has an f2c
+     command, unless you've checked that overwriting it
+     is okay.  Else, touch f2c-exists-ok.]
+     
+     sh[11]# ./configure --prefix=/usr
+     [Do not do the above if gcc is not installed in /usr/bin.
+     You might need a different --prefix=..., as
+     described below.]
+     
+     sh[12]# make bootstrap
+     [This takes a long time, and is where most problems occur.]
+     
+     sh[13]# rm -fr stage1
+     
+     sh[14]# make -k install
+     [The actual installation.]
+     
+     sh[15]# g77 -v
+     [Verify that g77 is installed, obtain version info.]
+     
+     sh[16]#
+
+   *Note Updating Your Info Directory: Updating Documentation, for
+information on how to update your system's top-level `info' directory
+to contain a reference to this manual, so that users of `g77' can
+easily find documentation instead of having to ask you for it.
+
+   Elaborations of many of the above steps follows:
+
+Step 1: `cd /usr/src'
+     You can build `g77' pretty much anyplace.  By convention, this
+     manual assumes `/usr/src'.  It might be helpful if other users on
+     your system knew where to look for the source code for the
+     installed version of `g77' and `gcc' in any case.
+
+Step 3: `gunzip -d < /usr/FSF/g77-0.5.21.tar.gz | tar xf -'
+     It is not always necessary to obtain the latest version of `g77'
+     as a complete `.tar.gz' file if you have a complete, earlier
+     distribution of `g77'.  If appropriate, you can unpack that earlier
+     version of `g77', and then apply the appropriate patches to
+     achieve the same result--a source tree containing version 0.5.21
+     of `g77'.
+
+Step 4: `ln -s gcc-2.7.2.2 gcc'
+
+Step 5: `ln -s g77-0.5.21 g77'
+     These commands mainly help reduce typing, and help reduce visual
+     clutter in examples in this manual showing what to type to install
+     `g77'.
+
+     *Note Unpacking::, for information on using distributions of `g77'
+     made by organizations other than the FSF.
+
+Step 6: `mv -i g77/* gcc'
+     After doing this, you can, if you like, type `rm g77' and `rmdir
+     g77-0.5.21' to remove the empty directory and the symbol link to
+     it.  But, it might be helpful to leave them around as quick
+     reminders of which version(s) of `g77' are installed on your
+     system.
+
+     *Note Unpacking::, for information on the contents of the `g77'
+     directory (as merged into the `gcc' directory).
+
+Step 7: `patch -p1 ...'
+     This can produce a wide variety of printed output, from `Hmm, I
+     can't seem to find a patch in there anywhere...'  to long lists of
+     messages indicated that patches are being found, applied
+     successfully, and so on.
+
+     If messages about "fuzz", "offset", or especially "reject files"
+     are printed, it might mean you applied the wrong patch file.  If
+     you believe this is the case, it is best to restart the sequence
+     after deleting (or at least renaming to unused names) the
+     top-level directories for `g77' and `gcc' and their symbolic links.
+
+     After this command finishes, the `gcc' directory might have old
+     versions of several files as saved by `patch'.  To remove these,
+     after `cd gcc', type `rm -i *.~*~'.
+
+     *Note Merging Distributions::, for more information.
+
+Step 9: `touch f77-install-ok'
+     Don't do this if you don't want to overwrite an existing version
+     of `f77' (such as a native compiler, or a script that invokes
+     `f2c').  Otherwise, installation will overwrite the `f77' command
+     and the `f77' man pages with copies of the corresponding `g77'
+     material.
+
+     *Note Installing `f77': Installing f77, for more information.
+
+Step 10: `touch f2c-install-ok'
+     Don't do this if you don't want to overwrite an existing
+     installation of `libf2c' (though, chances are, you do).  Instead,
+     `touch f2c-exists-ok' to allow the installation to continue
+     without any error messages about `/usr/lib/libf2c.a' already
+     existing.
+
+     *Note Installing `f2c': Installing f2c, for more information.
+
+Step 11: `./configure --prefix=/usr'
+     This is where you specify that the `g77' executable is to be
+     installed in `/usr/bin/', the `libf2c.a' library is to be
+     installed in `/usr/lib/', and so on.
+
+     You should ensure that any existing installation of the `gcc'
+     executable is in `/usr/bin/'.  Otherwise, installing `g77' so that
+     it does not fully replace the existing installation of `gcc' is
+     likely to result in the inability to compile Fortran programs.
+
+     *Note Where in the World Does Fortran (and GNU CC) Go?: Where to
+     Install, for more information on determining where to install
+     `g77'.  *Note Configuring gcc::, for more information on the
+     configuration process triggered by invoking the `./configure'
+     script.
+
+Step 12: `make bootstrap'
+     *Note Installing GNU CC: (gcc)Installation, for information on the
+     kinds of diagnostics you should expect during this procedure.
+
+     *Note Building gcc::, for complete `g77'-specific information on
+     this step.
+
+Step 13: `rm -fr stage1'
+     You don't need to do this, but it frees up disk space.
+
+Step 14: `make -k install'
+     If this doesn't seem to work, try:
+
+          make -k install install-libf77 install-f2c-all
+
+     *Note Installation of Binaries::, for more information.
+
+     *Note Updating Your Info Directory: Updating Documentation, for
+     information on entering this manual into your system's list of
+     texinfo manuals.
+
+Step 15: `g77 -v'
+     If this command prints approximately 25 lines of output, including
+     the GNU Fortran Front End version number (which should be the same
+     as the version number for the version of `g77' you just built and
+     installed) and the version numbers for the three parts of the
+     `libf2c' library (`libF77', `libI77', `libU77'), and those version
+     numbers are all in agreement, then there is a high likelihood that
+     the installation has been successfully completed.
+
+     You might consider doing further testing.  For example, log in as
+     a non-privileged user, then create a small Fortran program, such
+     as:
+
+                PROGRAM SMTEST
+                DO 10 I=1, 10
+                   PRINT *, 'Hello World #', I
+          10    CONTINUE
+                END
+
+     Compile, link, and run the above program, and, assuming you named
+     the source file `smtest.f', the session should look like this:
+
+          sh# g77 -o smtest smtest.f
+          sh# ./smtest
+           Hello World # 1
+           Hello World # 2
+           Hello World # 3
+           Hello World # 4
+           Hello World # 5
+           Hello World # 6
+           Hello World # 7
+           Hello World # 8
+           Hello World # 9
+           Hello World # 10
+          sh#
+
+     After proper installation, you don't need to keep your gcc and g77
+     source and build directories around anymore.  Removing them can
+     free up a lot of disk space.
+
+Complete Installation
+=====================
+
+   Here is the complete `g77'-specific information on how to configure,
+build, and install `g77'.
+
+Unpacking
+---------
+
+   The `gcc' source distribution is a stand-alone distribution.  It is
+designed to be unpacked (producing the `gcc' source tree) and built as
+is, assuming certain prerequisites are met (including the availability
+of compatible UNIX programs such as `make', `cc', and so on).
+
+   However, before building `gcc', you will want to unpack and merge
+the `g77' distribution in with it, so that you build a Fortran-capable
+version of `gcc', which includes the `g77' command, the necessary
+run-time libraries, and this manual.
+
+   Unlike `gcc', the `g77' source distribution is *not* a stand-alone
+distribution.  It is designed to be unpacked and, afterwards,
+immediately merged into an applicable `gcc' source tree.  That is, the
+`g77' distribution *augments* a `gcc' distribution--without `gcc',
+generally only the documentation is immediately usable.
+
+   A sequence of commands typically used to unpack `gcc' and `g77' is:
+
+     sh# cd /usr/src
+     sh# gunzip -d < /usr/FSF/gcc-2.7.2.2.tar.gz | tar xf -
+     sh# gunzip -d < /usr/FSF/g77-0.5.21.tar.gz | tar xf -
+     sh# ln -s gcc-2.7.2.2 gcc
+     sh# ln -s g77-0.5.21 g77
+     sh# mv -i g77/* gcc
+
+   *Notes:* The commands beginning with `gunzip...' might print `Broken
+pipe...' as they complete.  That is nothing to worry about, unless you
+actually *hear* a pipe breaking.  The `ln' commands are helpful in
+reducing typing and clutter in installation examples in this manual.
+Hereafter, the top level of `gcc' source tree is referred to as `gcc',
+and the top level of just the `g77' source tree (prior to issuing the
+`mv' command, above) is referred to as `g77'.
+
+   There are three top-level names in a `g77' distribution:
+
+     g77/COPYING.g77
+     g77/README.g77
+     g77/f
+
+   All three entries should be moved (or copied) into a `gcc' source
+tree (typically named after its version number and as it appears in the
+FSF distributions--e.g. `gcc-2.7.2.2').
+
+   `g77/f' is the subdirectory containing all of the code,
+documentation, and other information that is specific to `g77'.  The
+other two files exist to provide information on `g77' to someone
+encountering a `gcc' source tree with `g77' already present, who has
+not yet read these installation instructions and thus needs help
+understanding that the source tree they are looking at does not come
+from a single FSF distribution.  They also help people encountering an
+unmerged `g77' source tree for the first time.
+
+   *Note:* Please use *only* `gcc' and `g77' source trees as
+distributed by the FSF.  Use of modified versions, such as the
+Pentium-specific-optimization port of `gcc', is likely to result in
+problems that appear to be in the `g77' code but, in fact, are not.  Do
+not use such modified versions unless you understand all the
+differences between them and the versions the FSF distributes--in which
+case you should be able to modify the `g77' (or `gcc') source trees
+appropriately so `g77' and `gcc' can coexist as they do in the stock
+FSF distributions.
+
+Merging Distributions
+---------------------
+
+   After merging the `g77' source tree into the `gcc' source tree, the
+final merge step is done by applying the pertinent patches the `g77'
+distribution provides for the `gcc' source tree.
+
+   Read the file `gcc/f/gbe/README', and apply the appropriate patch
+file for the version of the GNU CC compiler you have, if that exists.
+If the directory exists but the appropriate file does not exist, you
+are using either an old, unsupported version, or a release one that is
+newer than the newest `gcc' version supported by the version of `g77'
+you have.
+
+   As of version 0.5.18, `g77' modifies the version number of `gcc' via
+the pertinent patches.  This is done because the resulting version of
+`gcc' is deemed sufficiently different from the vanilla distribution to
+make it worthwhile to present, to the user, information signaling the
+fact that there are some differences.
+
+   GNU version numbers make it easy to figure out whether a particular
+version of a distribution is newer or older than some other version of
+that distribution.  The format is, generally, MAJOR.MINOR.PATCH, with
+each field being a decimal number.  (You can safely ignore leading
+zeros; for example, 1.5.3 is the same as 1.5.03.)  The MAJOR field only
+increases with time.  The other two fields are reset to 0 when the
+field to their left is incremented; otherwise, they, too, only increase
+with time.  So, version 2.6.2 is newer than version 2.5.8, and version
+3.0 is newer than both.  (Trailing `.0' fields often are omitted in
+announcements and in names for distributions and the directories they
+create.)
+
+   If your version of `gcc' is older than the oldest version supported
+by `g77' (as casually determined by listing the contents of
+`gcc/f/gbe/'), you should obtain a newer, supported version of `gcc'.
+(You could instead obtain an older version of `g77', or try and get
+your `g77' to work with the old `gcc', but neither approach is
+recommended, and you shouldn't bother reporting any bugs you find if you
+take either approach, because they're probably already fixed in the
+newer versions you're not using.)
+
+   If your version of `gcc' is newer than the newest version supported
+by `g77', it is possible that your `g77' will work with it anyway.  If
+the version number for `gcc' differs only in the PATCH field, you might
+as well try applying the `g77' patch that is for the newest version of
+`gcc' having the same MAJOR and MINOR fields, as this is likely to work.
+
+   So, for example, if a particular version of `g77' has support for
+`gcc' versions 2.7.0 and 2.7.1, it is likely that `gcc-2.7.2' would
+work well with `g77' by using the `2.7.1.diff' patch file provided with
+`g77' (aside from some offsets reported by `patch', which usually are
+harmless).
+
+   However, `gcc-2.8.0' would almost certainly not work with that
+version of `g77' no matter which patch file was used, so a new version
+of `g77' would be needed (and you should wait for it rather than
+bothering the maintainers--*note User-Visible Changes: Changes.).
+
+   This complexity is the result of `gcc' and `g77' being separate
+distributions.  By keeping them separate, each product is able to be
+independently improved and distributed to its user base more frequently.
+
+   However, `g77' often requires changes to contemporary versions of
+`gcc'.  Also, the GBE interface defined by `gcc' typically undergoes
+some incompatible changes at least every time the MINOR field of the
+version number is incremented, and such changes require corresponding
+changes to the `g77' front end (FFE).
+
+   It is hoped that the GBE interface, and the `gcc' and `g77' products
+in general, will stabilize sufficiently for the need for hand-patching
+to disappear.
+
+   Invoking `patch' as described in `gcc/f/gbe/README' can produce a
+wide variety of printed output, from `Hmm, I can't seem to find a patch
+in there anywhere...'  to long lists of messages indicated that patches
+are being found, applied successfully, and so on.
+
+   If messages about "fuzz", "offset", or especially "reject files" are
+printed, it might mean you applied the wrong patch file.  If you
+believe this is the case, it is best to restart the sequence after
+deleting (or at least renaming to unused names) the top-level
+directories for `g77' and `gcc' and their symbolic links.  That is
+because `patch' might have partially patched some `gcc' source files,
+so reapplying the correct patch file might result in the correct
+patches being applied incorrectly (due to the way `patch' necessarily
+works).
+
+   After `patch' finishes, the `gcc' directory might have old versions
+of several files as saved by `patch'.  To remove these, after `cd gcc',
+type `rm -i *.~*~'.
+
+   *Note:* `g77''s configuration file `gcc/f/config-lang.in' ensures
+that the source code for the version of `gcc' being configured has at
+least one indication of being patched as required specifically by `g77'.
+This configuration-time checking should catch failure to apply the
+correct patch and, if so caught, should abort the configuration with an
+explanation.  *Please* do not try to disable the check, otherwise `g77'
+might well appear to build and install correctly, and even appear to
+compile correctly, but could easily produce broken code.
+
+   `diff -rcp2N' is used to create the patch files in `gcc/f/gbe/'.
+
+Installing `f77'
+----------------
+
+   You should decide whether you want installation of `g77' to also
+install an `f77' command.  On systems with a native `f77', this is not
+normally desired, so `g77' does not do this by default.
+
+   If you want `f77' installed, create the file `f77-install-ok' (e.g.
+via the UNIX command `touch f77-install-ok') in the source or build
+top-level directory (the same directory in which the `g77' `f'
+directory resides, not the `f' directory itself), or edit
+`gcc/f/Make-lang.in' and change the definition of the
+`F77_INSTALL_FLAG' macro appropriately.
+
+   Usually, this means that, after typing `cd gcc', you would type
+`touch f77-install-ok'.
+
+   When you enable installation of `f77', either a link to or a direct
+copy of the `g77' command is made.  Similarly, `f77.1' is installed as
+a man page.
+
+   (The `uninstall' target in the `gcc/Makefile' also tests this macro
+and file, when invoked, to determine whether to delete the installed
+copies of `f77' and `f77.1'.)
+
+   *Note:* No attempt is yet made to install a program (like a shell
+script) that provides compatibility with any other `f77' programs.
+Only the most rudimentary invocations of `f77' will work the same way
+with `g77'.
+
+Installing `f2c'
+----------------
+
+   Currently, `g77' does not include `f2c' itself in its distribution.
+However, it does include a modified version of the `libf2c'.  This
+version is normally compatible with `f2c', but has been modified to
+meet the needs of `g77' in ways that might possibly be incompatible
+with some versions or configurations of `f2c'.
+
+   Decide how installation of `g77' should affect any existing
+installation of `f2c' on your system.
+
+   If you do not have `f2c' on your system (e.g. no `/usr/bin/f2c', no
+`/usr/include/f2c.h', and no `/usr/lib/libf2c.a', `/usr/lib/libF77.a',
+or `/usr/lib/libI77.a'), you don't need to be concerned with this item.
+
+   If you do have `f2c' on your system, you need to decide how users of
+`f2c' will be affected by your installing `g77'.  Since `g77' is
+currently designed to be object-code-compatible with `f2c' (with very
+few, clear exceptions), users of `f2c' might want to combine
+`f2c'-compiled object files with `g77'-compiled object files in a
+single executable.
+
+   To do this, users of `f2c' should use the same copies of `f2c.h' and
+`libf2c.a' that `g77' uses (and that get built as part of `g77').
+
+   If you do nothing here, the `g77' installation process will not
+overwrite the `include/f2c.h' and `lib/libf2c.a' files with its own
+versions, and in fact will not even install `libf2c.a' for use with the
+newly installed versions of `gcc' and `g77' if it sees that
+`lib/libf2c.a' exists--instead, it will print an explanatory message
+and skip this part of the installation.
+
+   To install `g77''s versions of `f2c.h' and `libf2c.a' in the
+appropriate places, create the file `f2c-install-ok' (e.g. via the UNIX
+command `touch f2c-install-ok') in the source or build top-level
+directory (the same directory in which the `g77' `f' directory resides,
+not the `f' directory itself), or edit `gcc/f/Make-lang.in' and change
+the definition of the `F2C_INSTALL_FLAG' macro appropriately.
+
+   Usually, this means that, after typing `cd gcc', you would type
+`touch f2c-install-ok'.
+
+   Make sure that when you enable the overwriting of `f2c.h' and
+`libf2c.a' as used by `f2c', you have a recent and properly configured
+version of `bin/f2c' so that it generates code that is compatible with
+`g77'.
+
+   If you don't want installation of `g77' to overwrite `f2c''s existing
+installation, but you do want `g77' installation to proceed with
+installation of its own versions of `f2c.h' and `libf2c.a' in places
+where `g77' will pick them up (even when linking `f2c'-compiled object
+files--which might lead to incompatibilities), create the file
+`f2c-exists-ok' (e.g. via the UNIX command `touch f2c-exists-ok') in
+the source or build top-level directory, or edit `gcc/f/Make-lang.in'
+and change the definition of the `F2CLIBOK' macro appropriately.
+
+Patching GNU Fortran
+--------------------
+
+   If you're using a SunOS4 system, you'll need to make the following
+change to `gcc/f/proj.h': edit the line reading
+
+     #define FFEPROJ_STRTOUL 1  ...
+
+by replacing the `1' with `0'.  Or, you can avoid editing the source by
+adding
+     CFLAGS='-DFFEPROJ_STRTOUL=0 -g -O'
+   to the command line for `make' when you invoke it.  (`-g' is the
+default for `CFLAGS'.)
+
+   This causes a minimal version of `strtoul()' provided as part of the
+`g77' distribution to be compiled and linked into whatever `g77'
+programs need it, since some systems (like SunOS4 with only the bundled
+compiler and its runtime) do not provide this function in their system
+libraries.
+
+   Similarly, a minimal version of `bsearch()' is available and can be
+enabled by editing a line similar to the one for `strtoul()' above in
+`gcc/f/proj.h', if your system libraries lack `bsearch()'.  The method
+of overriding `X_CFLAGS' may also be used.
+
+   These are not problems with `g77', which requires an ANSI C
+environment.  You should upgrade your system to one that provides a
+full ANSI C environment, or encourage the maintainers of `gcc' to
+provide one to all `gcc'-based compilers in future `gcc' distributions.
+
+   *Note Problems Installing::, for more information on why `strtoul()'
+comes up missing and on approaches to dealing with this problem that
+have already been tried.
+
+Where in the World Does Fortran (and GNU CC) Go?
+------------------------------------------------
+
+   Before configuring, you should make sure you know where you want the
+`g77' and `gcc' binaries to be installed after they're built, because
+this information is given to the configuration tool and used during the
+build itself.
+
+   A `g77' installation necessarily requires installation of a
+`g77'-aware version of `gcc', so that the `gcc' command recognizes
+Fortran source files and knows how to compile them.
+
+   For this to work, the version of `gcc' that you will be building as
+part of `g77' *must* be installed as the "active" version of `gcc' on
+the system.
+
+   Sometimes people make the mistake of installing `gcc' as
+`/usr/local/bin/gcc', leaving an older, non-Fortran-aware version in
+`/usr/bin/gcc'.  (Or, the opposite happens.)  This can result in `g77'
+being unable to compile Fortran source files, because when it calls on
+`gcc' to do the actual compilation, `gcc' complains that it does not
+recognize the language, or the file name suffix.
+
+   So, determine whether `gcc' already is installed on your system,
+and, if so, *where* it is installed, and prepare to configure the new
+version of `gcc' you'll be building so that it installs over the
+existing version of `gcc'.
+
+   You might want to back up your existing copy of `bin/gcc', and the
+entire `lib/' directory, before you perform the actual installation (as
+described in this manual).
+
+   Existing `gcc' installations typically are found in `/usr' or
+`/usr/local'.  If you aren't certain where the currently installed
+version of `gcc' and its related programs reside, look at the output of
+this command:
+
+     gcc -v -o /tmp/delete-me -xc /dev/null -xnone
+
+   All sorts of interesting information on the locations of various
+`gcc'-related programs and data files should be visible in the output
+of the above command.  (The output also is likely to include a
+diagnostic from the linker, since there's no `main_()' function.)
+However, you do have to sift through it yourself; `gcc' currently
+provides no easy way to ask it where it is installed and where it looks
+for the various programs and data files it calls on to do its work.
+
+   Just *building* `g77' should not overwrite any installed
+programs--but, usually, after you build `g77', you will want to install
+it, so backing up anything it might overwrite is a good idea.  (This is
+true for any package, not just `g77', though in this case it is
+intentional that `g77' overwrites `gcc' if it is already installed--it
+is unusual that the installation process for one distribution
+intentionally overwrites a program or file installed by another
+distribution.)
+
+   Another reason to back up the existing version first, or make sure
+you can restore it easily, is that it might be an older version on
+which other users have come to depend for certain behaviors.  However,
+even the new version of `gcc' you install will offer users the ability
+to specify an older version of the actual compilation programs if
+desired, and these older versions need not include any `g77' components.
+*Note Specifying Target Machine and Compiler Version: (gcc)Target
+Options, for information on the `-V' option of `gcc'.
+
+Configuring GNU CC
+------------------
+
+   `g77' is configured automatically when you configure `gcc'.  There
+are two parts of `g77' that are configured in two different
+ways--`g77', which "camps on" to the `gcc' configuration mechanism, and
+`libf2c', which uses a variation of the GNU `autoconf' configuration
+system.
+
+   Generally, you shouldn't have to be concerned with either `g77' or
+`libf2c' configuration, unless you're configuring `g77' as a
+cross-compiler.  In this case, the `libf2c' configuration, and possibly
+the `g77' and `gcc' configurations as well, might need special
+attention.  (This also might be the case if you're porting `gcc' to a
+whole new system--even if it is just a new operating system on an
+existing, supported CPU.)
+
+   To configure the system, see *Note Installing GNU CC:
+(gcc)Installation, following the instructions for running `./configure'.
+Pay special attention to the `--prefix=' option, which you almost
+certainly will need to specify.
+
+   (Note that `gcc' installation information is provided as a straight
+text file in `gcc/INSTALL'.)
+
+   The information printed by the invocation of `./configure' should
+show that the `f' directory (the Fortran language) has been configured.
+If it does not, there is a problem.
+
+   *Note:* Configuring with the `--srcdir' argument is known to work
+with GNU `make', but it is not known to work with other variants of
+`make'.  Irix5.2 and SunOS4.1 versions of `make' definitely won't work
+outside the source directory at present.  `g77''s portion of the
+`configure' script issues a warning message about this when you
+configure for building binaries outside the source directory.
+
+Building GNU CC
+---------------
+
+   Building `g77' requires building enough of `gcc' that these
+instructions assume you're going to build all of `gcc', including
+`g++', `protoize', and so on.  You can save a little time and disk
+space by changes the `LANGUAGES' macro definition in `gcc/Makefile.in'
+or `gcc/Makefile', but if you do that, you're on your own.  One change
+is almost *certainly* going to cause failures: removing `c' or `f77'
+from the definition of the `LANGUAGES' macro.
+
+   After configuring `gcc', which configures `g77' and `libf2c'
+automatically, you're ready to start the actual build by invoking
+`make'.
+
+   *Note:* You *must* have run `./configure' before you run `make',
+even if you're using an already existing `gcc' development directory,
+because `./configure' does the work to recognize that you've added
+`g77' to the configuration.
+
+   There are two general approaches to building GNU CC from scratch:
+
+"bootstrap"
+     This method uses minimal native system facilities to build a
+     barebones, unoptimized `gcc', that is then used to compile
+     ("bootstrap") the entire system.
+
+"straight"
+     This method assumes a more complete native system exists, and uses
+     that just once to build the entire system.
+
+   On all systems without a recent version of `gcc' already installed,
+the bootstrap method must be used.  In particular, `g77' uses
+extensions to the C language offered, apparently, only by `gcc'.
+
+   On most systems with a recent version of `gcc' already installed,
+the straight method can be used.  This is an advantage, because it
+takes less CPU time and disk space for the build.  However, it does
+require that the system have fairly recent versions of many GNU
+programs and other programs, which are not enumerated here.
+
+Bootstrap Build
+...............
+
+   A complete bootstrap build is done by issuing a command beginning
+with `make bootstrap ...', as described in *Note Installing GNU CC:
+(gcc)Installation.  This is the most reliable form of build, but it
+does require the most disk space and CPU time, since the complete system
+is built twice (in Stages 2 and 3), after an initial build (during
+Stage 1) of a minimal `gcc' compiler using the native compiler and
+libraries.
+
+   You might have to, or want to, control the way a bootstrap build is
+done by entering the `make' commands to build each stage one at a time,
+as described in the `gcc' manual.  For example, to save time or disk
+space, you might want to not bother doing the Stage 3 build, in which
+case you are assuming that the `gcc' compiler you have built is
+basically sound (because you are giving up the opportunity to compare a
+large number of object files to ensure they're identical).
+
+   To save some disk space during installation, after Stage 2 is built,
+you can type `rm -fr stage1' to remove the binaries built during Stage
+1.
+
+   *Note:* *Note Object File Differences::, for information on expected
+differences in object files produced during Stage 2 and Stage 3 of a
+bootstrap build.  These differences will be encountered as a result of
+using the `make compare' or similar command sequence recommended by the
+GNU CC installation documentation.
+
+   Also, *Note Installing GNU CC: (gcc)Installation, for important
+information on building `gcc' that is not described in this `g77'
+manual.  For example, explanations of diagnostic messages and whether
+they're expected, or indicate trouble, are found there.
+
+Straight Build
+..............
+
+   If you have a recent version of `gcc' already installed on your
+system, and if you're reasonably certain it produces code that is
+object-compatible with the version of `gcc' you want to build as part
+of building `g77', you can save time and disk space by doing a straight
+build.
+
+   To build just the C and Fortran compilers and the necessary run-time
+libraries, issue the following command:
+
+     make -k CC=gcc LANGUAGES=f77 all g77
+
+   (The `g77' target is necessary because the `gcc' build procedures
+apparently do not automatically build command drivers for languages in
+subdirectories.  It's the `all' target that triggers building
+everything except, apparently, the `g77' command itself.)
+
+   If you run into problems using this method, you have two options:
+
+   * Abandon this approach and do a bootstrap build.
+
+   * Try to make this approach work by diagnosing the problems you're
+     running into and retrying.
+
+   Especially if you do the latter, you might consider submitting any
+solutions as bug/fix reports.  *Note Known Causes of Trouble with GNU
+Fortran: Trouble.
+
+   However, understand that many problems preventing a straight build
+from working are not `g77' problems, and, in such cases, are not likely
+to be addressed in future versions of `g77'.
+
+Pre-installation Checks
+-----------------------
+
+   Before installing the system, which includes installing `gcc', you
+might want to do some minimum checking to ensure that some basic things
+work.
+
+   Here are some commands you can try, and output typically printed by
+them when they work:
+
+     sh# cd /usr/src/gcc
+     sh# ./g77 --driver=./xgcc -B./ -v
+     g77 version 0.5.21
+      ./xgcc -B./ -v -fnull-version -o /tmp/gfa18047 ...
+     Reading specs from ./specs
+     gcc version 2.7.2.2.f.3
+      ./cpp -lang-c -v -isystem ./include -undef ...
+     GNU CPP version 2.7.2.2.f.3 (Linux/Alpha)
+     #include "..." search starts here:
+     #include <...> search starts here:
+      ./include
+      /usr/local/include
+      /usr/alpha-unknown-linux/include
+      /usr/lib/gcc-lib/alpha-unknown-linux/2.7.2.2.f.3/include
+      /usr/include
+     End of search list.
+      ./f771 /tmp/cca18048.i -fset-g77-defaults -quiet -dumpbase ...
+     GNU F77 version 2.7.2.2.f.3 (Linux/Alpha) compiled ...
+     GNU Fortran Front End version 0.5.21 compiled: ...
+      as -nocpp -o /tmp/cca180481.o /tmp/cca18048.s
+      ld -G 8 -O1 -o /tmp/gfa18047 /usr/lib/crt0.o -L. ...
+     __G77_LIBF77_VERSION__: 0.5.21
+     @(#)LIBF77 VERSION 19970404
+     __G77_LIBI77_VERSION__: 0.5.21
+     @(#) LIBI77 VERSION pjw,dmg-mods 19970527
+     __G77_LIBU77_VERSION__: 0.5.21
+     @(#) LIBU77 VERSION 19970609
+     sh# ./xgcc -B./ -v -o /tmp/delete-me -xc /dev/null -xnone
+     Reading specs from ./specs
+     gcc version 2.7.2.2.f.3
+      ./cpp -lang-c -v -isystem ./include -undef ...
+     GNU CPP version 2.7.2.2.f.3 (Linux/Alpha)
+     #include "..." search starts here:
+     #include <...> search starts here:
+      ./include
+      /usr/local/include
+      /usr/alpha-unknown-linux/include
+      /usr/lib/gcc-lib/alpha-unknown-linux/2.7.2.2.f.3/include
+      /usr/include
+     End of search list.
+      ./cc1 /tmp/cca18063.i -quiet -dumpbase null.c -version ...
+     GNU C version 2.7.2.2.f.3 (Linux/Alpha) compiled ...
+      as -nocpp -o /tmp/cca180631.o /tmp/cca18063.s
+      ld -G 8 -O1 -o /tmp/delete-me /usr/lib/crt0.o -L. ...
+     /usr/lib/crt0.o: In function `__start':
+     crt0.S:110: undefined reference to `main'
+     /usr/lib/crt0.o(.lita+0x28): undefined reference to `main'
+     sh#
+
+   (Note that long lines have been truncated, and `...'  used to
+indicate such truncations.)
+
+   The above two commands test whether `g77' and `gcc', respectively,
+are able to compile empty (null) source files, whether invocation of
+the C preprocessor works, whether libraries can be linked, and so on.
+
+   If the output you get from either of the above two commands is
+noticeably different, especially if it is shorter or longer in ways
+that do not look consistent with the above sample output, you probably
+should not install `gcc' and `g77' until you have investigated further.
+
+   For example, you could try compiling actual applications and seeing
+how that works.  (You might want to do that anyway, even if the above
+tests work.)
+
+   To compile using the not-yet-installed versions of `gcc' and `g77',
+use the following commands to invoke them.
+
+   To invoke `g77', type:
+
+     /usr/src/gcc/g77 --driver=/usr/src/gcc/xgcc -B/usr/src/gcc/ ...
+
+   To invoke `gcc', type:
+
+     /usr/src/gcc/xgcc -B/usr/src/gcc/ ...
+
+Installation of Binaries
+------------------------
+
+   After configuring, building, and testing `g77' and `gcc', when you
+are ready to install them on your system, type:
+
+     make -k CC=gcc LANGUAGES=f77 install
+
+   As described in *Note Installing GNU CC: (gcc)Installation, the
+values for the `CC' and `LANGUAGES' macros should be the same as those
+you supplied for the build itself.
+
+   So, the details of the above command might vary if you used a
+bootstrap build (where you might be able to omit both definitions, or
+might have to supply the same definitions you used when building the
+final stage) or if you deviated from the instructions for a straight
+build.
+
+   If the above command does not install `libf2c.a' as expected, try
+this:
+
+     make -k ... install install-libf77 install-f2c-all
+
+   We don't know why some non-GNU versions of `make' sometimes require
+this alternate command, but they do.  (Remember to supply the
+appropriate definitions for `CC' and `LANGUAGES' where you see `...' in
+the above command.)
+
+   Note that using the `-k' option tells `make' to continue after some
+installation problems, like not having `makeinfo' installed on your
+system.  It might not be necessary for your system.
+
+Updating Your Info Directory
+----------------------------
+
+   As part of installing `g77', you should make sure users of `info'
+can easily access this manual on-line.  Do this by making sure a line
+such as the following exists in `/usr/info/dir', or in whatever file is
+the top-level file in the `info' directory on your system (perhaps
+`/usr/local/info/dir':
+
+     * g77: (g77).           The GNU Fortran programming language.
+
+   If the menu in `dir' is organized into sections, `g77' probably
+belongs in a section with a name such as one of the following:
+
+   * Fortran Programming
+
+   * Writing Programs
+
+   * Programming Languages
+
+   * Languages Other Than C
+
+   * Scientific/Engineering Tools
+
+   * GNU Compilers
+
+Missing `bison'?
+----------------
+
+   If you cannot install `bison', make sure you have started with a
+*fresh* distribution of `gcc', do *not* do `make maintainer-clean' (in
+other versions of `gcc', this was called `make realclean'), and, to
+ensure that `bison' is not invoked by `make' during the build, type
+these commands:
+
+     sh# cd gcc
+     sh# touch bi-parser.c bi-parser.h c-parse.c c-parse.h cexp.c
+     sh# touch cp/parse.c cp/parse.h objc-parse.c
+     sh#
+
+   These commands update the date-time-modified information for all the
+files produced by the various invocations of `bison' in the current
+versions of `gcc', so that `make' no longer believes it needs to update
+them.  All of these files should already exist in a `gcc' distribution,
+but the application of patches to upgrade to a newer version can leave
+the modification information set such that the `bison' input files look
+more "recent" than the corresponding output files.
+
+   *Note:* New versions of `gcc' might change the set of files it
+generates by invoking `bison'--if you cannot figure out for yourself
+how to handle such a situation, try an older version of `gcc' until you
+find someone who can (or until you obtain and install `bison').
+
+Missing `makeinfo'?
+-------------------
+
+   If you cannot install `makeinfo', either use the `-k' option when
+invoking make to specify any of the `install' or related targets, or
+specify `MAKEINFO=echo' on the `make' command line.
+
+   If you fail to do one of these things, some files, like `libf2c.a',
+might not be installed, because the failed attempt by `make' to invoke
+`makeinfo' causes it to cancel any further processing.
+
+Distributing Binaries
+=====================
+
+   If you are building `g77' for distribution to others in binary form,
+first make sure you are aware of your legal responsibilities (read the
+file `gcc/COPYING' thoroughly).
+
+   Then, consider your target audience and decide where `g77' should be
+installed.
+
+   For systems like GNU/Linux that have no native Fortran compiler (or
+where `g77' could be considered the native compiler for Fortran and
+`gcc' for C, etc.), you should definitely configure `g77' for
+installation in `/usr/bin' instead of `/usr/local/bin'.  Specify the
+`--prefix=/usr' option when running `./configure'.  You might also want
+to set up the distribution so the `f77' command is a link to
+`g77'--just make an empty file named `f77-install-ok' in the source or
+build directory (the one in which the `f' directory resides, not the
+`f' directory itself) when you specify one of the `install' or
+`uninstall' targets in a `make' command.
+
+   For a system that might already have `f2c' installed, you definitely
+will want to make another empty file (in the same directory) named
+either `f2c-exists-ok' or `f2c-install-ok'.  Use the former if you
+don't want your distribution to overwrite `f2c'-related files in
+existing systems; use the latter if you want to improve the likelihood
+that users will be able to use both `f2c' and `g77' to compile code for
+a single program without encountering link-time or run-time
+incompatibilities.
+
+   (Make sure you clearly document, in the "advertising" for your
+distribution, how installation of your distribution will affect
+existing installations of `gcc', `f2c', `f77', `libf2c.a', and so on.
+Similarly, you should clearly document any requirements you assume are
+met by users of your distribution.)
+
+   For other systems with native `f77' (and `cc') compilers, configure
+`g77' as you (or most of your audience) would configure `gcc' for their
+installations.  Typically this is for installation in `/usr/local', and
+would not include a copy of `g77' named `f77', so users could still use
+the native `f77'.
+
+   In any case, for `g77' to work properly, you *must* ensure that the
+binaries you distribute include:
+
+`bin/g77'
+     This is the command most users use to compile Fortran.
+
+`bin/gcc'
+     This is the command all users use to compile Fortran, either
+     directly or indirectly via the `g77' command.  The `bin/gcc'
+     executable file must have been built from a `gcc' source tree into
+     which a `g77' source tree was merged and configured, or it will
+     not know how to compile Fortran programs.
+
+`bin/f77'
+     In installations with no non-GNU native Fortran compiler, this is
+     the same as `bin/g77'.  Otherwise, it should be omitted from the
+     distribution, so the one on already on a particular system does
+     not get overwritten.
+
+`info/g77.info*'
+     This is the documentation for `g77'.  If it is not included, users
+     will have trouble understanding diagnostics messages and other
+     such things, and will send you a lot of email asking questions.
+
+     Please edit this documentation (by editing `gcc/f/*.texi' and
+     doing `make doc' from the `/usr/src/gcc' directory) to reflect any
+     changes you've made to `g77', or at least to encourage users of
+     your binary distribution to report bugs to you first.
+
+     Also, whether you distribute binaries or install `g77' on your own
+     system, it might be helpful for everyone to add a line listing
+     this manual by name and topic to the top-level `info' node in
+     `/usr/info/dir'.  That way, users can find `g77' documentation more
+     easily.  *Note Updating Your Info Directory: Updating
+     Documentation.
+
+`man/man1/g77.1'
+     This is the short man page for `g77'.  It is out of date, but you
+     might as well include it for people who really like man pages.
+
+`man/man1/f77.1'
+     In installations where `f77' is the same as `g77', this is the
+     same as `man/man1/g77.1'.  Otherwise, it should be omitted from
+     the distribution, so the one already on a particular system does
+     not get overwritten.
+
+`lib/gcc-lib/.../f771'
+     This is the actual Fortran compiler.
+
+`lib/gcc-lib/.../libf2c.a'
+     This is the run-time library for `g77'-compiled programs.
+
+   Whether you want to include the slightly updated (and possibly
+improved) versions of `cc1', `cc1plus', and whatever other binaries get
+rebuilt with the changes the GNU Fortran distribution makes to the GNU
+back end, is up to you.  These changes are highly unlikely to break any
+compilers, and it is possible they'll fix back-end bugs that can be
+demonstrated using front ends other than GNU Fortran's.
+
+   Please assure users that unless they have a specific need for their
+existing, older versions of `gcc' command, they are unlikely to
+experience any problems by overwriting it with your version--though
+they could certainly protect themselves by making backup copies first!
+Otherwise, users might try and install your binaries in a "safe" place,
+find they cannot compile Fortran programs with your distribution
+(because, perhaps, they're picking up their old version of the `gcc'
+command, which does not recognize Fortran programs), and assume that
+your binaries (or, more generally, GNU Fortran distributions in
+general) are broken, at least for their system.
+
+   Finally, *please* ask for bug reports to go to you first, at least
+until you're sure your distribution is widely used and has been well
+tested.  This especially goes for those of you making any changes to
+the `g77' sources to port `g77', e.g. to OS/2.
+<fortran@gnu.ai.mit.edu> has received a fair number of bug reports that
+turned out to be problems with other peoples' ports and distributions,
+about which nothing could be done for the user.  Once you are quite
+certain a bug report does not involve your efforts, you can forward it
+to us.
+
diff --git a/gcc/f/Make-lang.in b/gcc/f/Make-lang.in
new file mode 100644
index 00000000000..7e59b6100c3
--- /dev/null
+++ b/gcc/f/Make-lang.in
@@ -0,0 +1,567 @@
+# Top level makefile fragment for GNU Fortran.           -*-makefile-*-
+#   Copyright (C) 1995-1997 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.info, foo.dvi,
+# foo.install-normal, foo.install-common, foo.install-info, foo.install-man,
+# foo.uninstall, foo.distdir,
+# foo.mostlyclean, foo.clean, foo.distclean, foo.extraclean,
+# 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: g77)
+# - the compiler proper (eg: f771)
+# - define the names for selecting the language in LANGUAGES.
+#
+# $(srcdir) must be set to the gcc/ source directory (not gcc/f/).
+
+# Extra flags to pass to recursive makes (and to sub-configure).
+# Use different quoting rules compared with FLAGS_TO_PASS so we can use
+# this to set environment variables as well
+# Note that GCC_FOR_TARGET, GCC_FLAGS aren't in here -- treated separately.
+F77_FLAGS_TO_PASS = \
+	CROSS="$(CROSS)" \
+	AR_FLAGS="$(AR_FLAGS)" \
+	AR_FOR_TARGET="$(AR_FOR_TARGET)" \
+	BISON="$(BISON)" \
+	BISONFLAGS="$(BISONFLAGS)" \
+	CC="$(CC)" \
+	CFLAGS="$(CFLAGS)" \
+	X_CFLAGS="$(X_CFLAGS)" \
+	LDFLAGS="$(LDFLAGS)" \
+	LEX="$(LEX)" \
+	LEXFLAGS="$(LEXFLAGS)" \
+	MAKEINFO="$(MAKEINFO)" \
+	MAKEINFOFLAGS="$(MAKEINFOFLAGS)" \
+	RANLIB_FOR_TARGET="$(RANLIB_FOR_TARGET)" \
+	RANLIB_TEST_FOR_TARGET="$(RANLIB_TEST_FOR_TARGET)" \
+	SHELL="$(SHELL)" \
+	exec_prefix="$(exec_prefix)" \
+	prefix="$(prefix)" \
+	tooldir="$(tooldir)" \
+	bindir="$(bindir)" \
+	libsubdir="$(libsubdir)"
+#	"F77_FOR_BUILD=$(F77_FOR_BUILD)" \
+#	"F77FLAGS=$(F77FLAGS)" \
+#	"F77_FOR_TARGET=$(F77_FOR_TARGET)"
+
+# This flag controls whether to install (overwrite) f77 on this system,
+# and also whether to uninstall it when using the uninstall target.
+# As shipped, the flag is a test of whether the `f77_install_ok'
+# file exists in the build or source directories (top level), but
+# you can just change it here if you like.
+F77_INSTALL_FLAG = [ -f f77-install-ok -o -f $(srcdir)/f77-install-ok ]
+
+# This flag is similar to F77_INSTALL_FLAG, but controls whether
+# to install (ovewrite) f2c-related items on this system.  Currently
+# these are `include/f2c.h' and `lib/libf2c.a', though at some point
+# `bin/f2c' itself might be added to the g77 distribution.
+F2C_INSTALL_FLAG = [ -f f2c-install-ok -o -f $(srcdir)/f2c-install-ok ]
+
+# This flag controls whether it is safe to install gcc's libf2c.a
+# even when there's already a lib/libf2c.a installed (which, unless
+# F2C_INSTALL_FLAG is set, will be left alone).
+F2CLIBOK = [ -f f2c-exists-ok -o -f $(srcdir)/f2c-exists-ok ]
+
+# Actual names to use when installing a native compiler.
+F77_INSTALL_NAME = `t='$(program_transform_name)'; echo f77 | sed $$t`
+G77_INSTALL_NAME = `t='$(program_transform_name)'; echo g77 | sed $$t`
+
+# Actual names to use when installing a cross-compiler.
+F77_CROSS_NAME = `t='$(program_transform_cross_name)'; echo f77 | sed $$t`
+G77_CROSS_NAME = `t='$(program_transform_cross_name)'; echo g77 | sed $$t`
+
+# 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 f77-runtime
+
+# Tell GNU make to ignore these if they exist.
+.PHONY: F77 f77 f77-runtime f77-runtime-unsafe f77.all.build f77.all.cross \
+  f77.start.encap f77.rest.encap f77.info f77.dvi maybe-f2c \
+  f77.install-normal install-libf77 install-f2c-all install-f2c-header \
+  install-f2c-lib f77.install-common f77.install-info f77.install-man \
+  f77.uninstall f77.mostlyclean f77.clean f77.distclean f77.extraclean \
+  f77.maintainer-clean f77.realclean f77.stage1 f77.stage2 f77.stage3 \
+  f77.stage4 f77.distdir f77.rebuilt
+
+# Create the compiler driver for g77 (only if `f77' is in LANGUAGES).
+g77: $(srcdir)/f/g77.c $(srcdir)/f/zzz.c $(CONFIG_H) $(LIBDEPS)
+	case '$(LANGUAGES)' in \
+	*f77*) \
+	  $(CC) $(ALL_CFLAGS) $(INCLUDES) $(LDFLAGS) \
+	    -o $@ $(srcdir)/f/g77.c $(srcdir)/f/zzz.c $(LIBS) ;; \
+	esac
+
+# Create a version of the g77 driver which calls the cross-compiler
+# (only if `f77' is in LANGUAGES).
+g77-cross: $(srcdir)/f/g77.c $(srcdir)/f/zzz.c version.o $(LIBDEPS)
+	case '$(LANGUAGES)' in \
+	*f77*) \
+	  $(CC) $(ALL_CFLAGS) $(INCLUDES) $(LDFLAGS) \
+	    -DGCC_NAME=\"$(GCC_CROSS_NAME)\" \
+	    -o $@ $(srcdir)/f/g77.c $(srcdir)/f/zzz.c $(LIBS) ;; \
+	esac
+
+F77_SRCS = \
+ $(srcdir)/f/assert.j \
+ $(srcdir)/f/bad.c \
+ $(srcdir)/f/bad.def \
+ $(srcdir)/f/bad.h \
+ $(srcdir)/f/bit.c \
+ $(srcdir)/f/bit.h \
+ $(srcdir)/f/bld-op.def \
+ $(srcdir)/f/bld.c \
+ $(srcdir)/f/bld.h \
+ $(srcdir)/f/com-rt.def \
+ $(srcdir)/f/com.c \
+ $(srcdir)/f/com.h \
+ $(srcdir)/f/config.j \
+ $(srcdir)/f/convert.j \
+ $(srcdir)/f/data.c \
+ $(srcdir)/f/data.h \
+ $(srcdir)/f/equiv.c \
+ $(srcdir)/f/equiv.h \
+ $(srcdir)/f/expr.c \
+ $(srcdir)/f/expr.h \
+ $(srcdir)/f/fini.c \
+ $(srcdir)/f/flags.j \
+ $(srcdir)/f/glimits.j \
+ $(srcdir)/f/global.c \
+ $(srcdir)/f/global.h \
+ $(srcdir)/f/hconfig.j \
+ $(srcdir)/f/implic.c \
+ $(srcdir)/f/implic.h \
+ $(srcdir)/f/input.j \
+ $(srcdir)/f/info-b.def \
+ $(srcdir)/f/info-k.def \
+ $(srcdir)/f/info-w.def \
+ $(srcdir)/f/info.c \
+ $(srcdir)/f/info.h \
+ $(srcdir)/f/intrin.c \
+ $(srcdir)/f/intrin.def \
+ $(srcdir)/f/intrin.h \
+ $(srcdir)/f/lab.c \
+ $(srcdir)/f/lab.h \
+ $(srcdir)/f/lex.c \
+ $(srcdir)/f/lex.h \
+ $(srcdir)/f/malloc.c \
+ $(srcdir)/f/malloc.h \
+ $(srcdir)/f/name.c \
+ $(srcdir)/f/name.h \
+ $(srcdir)/f/parse.c \
+ $(srcdir)/f/proj.c \
+ $(srcdir)/f/proj.h \
+ $(srcdir)/f/rtl.j \
+ $(srcdir)/f/src.c \
+ $(srcdir)/f/src.h \
+ $(srcdir)/f/st.c \
+ $(srcdir)/f/st.h \
+ $(srcdir)/f/sta.c \
+ $(srcdir)/f/sta.h \
+ $(srcdir)/f/stb.c \
+ $(srcdir)/f/stb.h \
+ $(srcdir)/f/stc.c \
+ $(srcdir)/f/stc.h \
+ $(srcdir)/f/std.c \
+ $(srcdir)/f/std.h \
+ $(srcdir)/f/ste.c \
+ $(srcdir)/f/ste.h \
+ $(srcdir)/f/storag.c \
+ $(srcdir)/f/storag.h \
+ $(srcdir)/f/stp.c \
+ $(srcdir)/f/stp.h \
+ $(srcdir)/f/str-1t.fin \
+ $(srcdir)/f/str-2t.fin \
+ $(srcdir)/f/str-fo.fin \
+ $(srcdir)/f/str-io.fin \
+ $(srcdir)/f/str-nq.fin \
+ $(srcdir)/f/str-op.fin \
+ $(srcdir)/f/str-ot.fin \
+ $(srcdir)/f/str.c \
+ $(srcdir)/f/str.h \
+ $(srcdir)/f/sts.c \
+ $(srcdir)/f/sts.h \
+ $(srcdir)/f/stt.c \
+ $(srcdir)/f/stt.h \
+ $(srcdir)/f/stu.c \
+ $(srcdir)/f/stu.h \
+ $(srcdir)/f/stv.c \
+ $(srcdir)/f/stv.h \
+ $(srcdir)/f/stw.c \
+ $(srcdir)/f/stw.h \
+ $(srcdir)/f/symbol.c \
+ $(srcdir)/f/symbol.def \
+ $(srcdir)/f/symbol.h \
+ $(srcdir)/f/target.c \
+ $(srcdir)/f/target.h \
+ $(srcdir)/f/tconfig.j \
+ $(srcdir)/f/tm.j \
+ $(srcdir)/f/top.c \
+ $(srcdir)/f/top.h \
+ $(srcdir)/f/tree.j \
+ $(srcdir)/f/type.c \
+ $(srcdir)/f/type.h \
+ $(srcdir)/f/where.c \
+ $(srcdir)/f/where.h \
+ $(srcdir)/f/zzz.c \
+ $(srcdir)/f/zzz.h
+
+f771: $(P) $(F77_SRCS) $(LIBDEPS) stamp-objlist f/Makefile
+	$(MAKE) -f f/Makefile $(FLAGS_TO_PASS) VPATH=$(srcdir) srcdir=$(srcdir) f771
+
+f/Makefile: $(srcdir)/f/Makefile.in $(srcdir)/configure
+	$(SHELL) config.status
+
+# Note that the runtime is built in the top-level directory rather
+# than in f/runtime a la the Cygnus CHILL example; then xgcc -B./ will
+# find it.  Use an absolute name for GCC_FOR_TARGET (so we don't have
+# to keep stage? links around everywhere) unless this value has been
+# overridden from the default "./xgcc -B./", hence the case statement.
+# We depend on GCC_PASSES through f/runtime/Makefile.
+stmp-headers = stmp-headers	# to be overrideable in unsafe version
+# Depend on stmp-headers, not stmp-int-hdrs, since libF77 needs float.h.
+f77-runtime:  f/runtime/Makefile include/f2c.h $(stmp-headers) \
+  f/runtime/libF77/Makefile f/runtime/libI77/Makefile f/runtime/libU77/Makefile
+	case "$(LANGUAGES)" in \
+	*f77*) top=`pwd`; \
+	  cd f/runtime && $(MAKE) \
+	    GCC_FOR_TARGET="`case '$(GCC_FOR_TARGET)' in \
+	     './xgcc -B./') echo $${top}/xgcc -B$${top}/;; \
+	     *) echo '$(GCC_FOR_TARGET)';; esac`" \
+	    GCC_FLAGS="$(GCC_FLAGS)" $(F77_FLAGS_TO_PASS) \
+	    all ;; \
+	esac
+
+# This one doesn't depend on cc1 etc. but f2c.h may not be found,
+# in particular, at present...
+f77-runtime-unsafe:
+	$(MAKE) stmp-headers= GCC_PARTS= f77-runtime
+
+# The configuration of the runtime system relies on an autoconf-type
+# configure, not a Cygnus-type one.  It needs to be run *after* the
+# appropriate (cross-)compiler has been built, thus depend on GCC_PARTS.
+# NB, sh uses the *first* value of $a from `a=fred a=joe prog'.
+include/f2c.h \
+f/runtime/Makefile \
+f/runtime/libF77/Makefile \
+f/runtime/libI77/Makefile \
+f/runtime/libU77/Makefile: \
+  $(srcdir)/f/runtime/f2c.h.in \
+  $(srcdir)/f/com.h $(srcdir)/f/proj.h \
+  $(srcdir)/f/runtime/Makefile.in \
+  $(srcdir)/f/runtime/libF77/Makefile.in \
+  $(srcdir)/f/runtime/libI77/Makefile.in \
+  $(srcdir)/f/runtime/libU77/Makefile.in \
+  $(srcdir)/f/runtime/configure \
+  $(srcdir)/f/runtime/libU77/configure \
+  $(GCC_PARTS)
+# The make "stage?" in compiler spec. is fully qualified as above
+	top=`pwd`; \
+	src=`cd $(srcdir); pwd`; \
+	  cd f/runtime; \
+	  CC="`case '$(GCC_FOR_TARGET)' in \
+	     './xgcc -B./') echo $${top}/xgcc -B$${top}/;; \
+	     *) echo '$(GCC_FOR_TARGET)';; esac`" \
+	  $(F77_FLAGS_TO_PASS) CONFIG_SITE=/dev/null $(SHELL) \
+	  $${src}/f/runtime/configure --srcdir=$${src}/f/runtime
+	top=`pwd`; \
+	src=`cd $(srcdir); pwd`; \
+	  cd f/runtime/libU77; \
+	  CC="`case '$(GCC_FOR_TARGET)' in \
+	     './xgcc -B./') echo $${top}/xgcc -B$${top}/;; \
+	     *) echo '$(GCC_FOR_TARGET)';; esac`" \
+	  $(F77_FLAGS_TO_PASS) CONFIG_SITE=/dev/null $(SHELL) \
+	  $${src}/f/runtime/libU77/configure --srcdir=$${src}/f/runtime/libU77
+
+#For now, omit f2c stuff.  -- burley
+#f2c: stmp-headers f/f2c/Makefile
+#	cd f/f2c; $(MAKE) all
+#
+#f/f2c/Makefile: $(srcdir)/f/f2c/Makefile.in $(GCC_PARTS) \
+#            $(srcdir)/config/$(xmake_file) $(srcdir)/config/$(tmake_file)
+#	top=`pwd`; cd f/f2c; \
+#          $${top}/f/f2c/configure --srcdir=$${top}/f/f2c
+
+# Build hooks:
+
+# I'm not sure there's a way of getting f2c into here conditionally on
+# the --enable-f2c flag detected by config-lang.in so kluge it with the
+# maybe-f2c target by looking at STAGESTUFF.
+f77.all.build: g77 maybe-f2c
+f77.all.cross: g77-cross maybe-f2c
+f77.start.encap: g77 maybe-f2c
+f77.rest.encap:
+
+f77.info: $(srcdir)/f/g77.info
+f77.dvi: $(srcdir)/f/g77.dvi
+
+# g77 documentation.
+$(srcdir)/f/g77.info: f/g77.texi f/bugs.texi f/install.texi f/news.texi f/intdoc.texi
+	cd $(srcdir)/f; $(MAKEINFO) g77.texi
+
+$(srcdir)/f/g77.dvi: f/g77.texi f/bugs.texi f/install.texi f/news.texi f/intdoc.texi
+	cd $(srcdir)/f; $(TEXI2DVI) g77.texi
+
+$(srcdir)/f/intdoc.texi: f/intdoc.c f/intdoc.h f/intrin.def f/intrin.h
+	$(HOST_CC) $(HOST_CFLAGS) $(HOST_LDFLAGS) \
+	      `echo $(srcdir)/f/intdoc.c | sed 's,^\./,,'` -o f/intdoc
+	f/intdoc > $(srcdir)/f/intdoc.texi
+	rm f/intdoc
+
+$(srcdir)/f/BUGS: f/bugs0.texi f/bugs.texi
+	cd $(srcdir)/f; $(MAKEINFO) -D BUGSONLY --no-header --no-split \
+	  --no-validate bugs0.texi -o BUGS
+
+$(srcdir)/f/INSTALL: f/install0.texi f/install.texi
+	cd $(srcdir)/f; $(MAKEINFO) -D INSTALLONLY --no-header --no-split \
+	  --no-validate install0.texi -o INSTALL
+
+$(srcdir)/f/NEWS: f/news0.texi f/news.texi
+	cd $(srcdir)/f; $(MAKEINFO) -D NEWSONLY --no-header --no-split \
+	  --no-validate news0.texi -o NEWS
+
+$(srcdir)/f/runtime/configure: $(srcdir)/f/runtime/configure.in 
+	cd f/runtime && $(MAKE) srcdir=../../$(srcdir)/f/runtime -f ../../$(srcdir)/f/runtime/Makefile.in rebuilt
+$(srcdir)/f/runtime/libU77/configure: $(srcdir)/f/runtime/libU77/configure.in
+	cd f/runtime && $(MAKE) srcdir=../../$(srcdir)/f/runtime -f ../../$(srcdir)/f/runtime/Makefile.in rebuilt
+
+f77.rebuilt: $(srcdir)/f/g77.info $(srcdir)/f/BUGS $(srcdir)/f/INSTALL \
+  $(srcdir)/f/NEWS $(srcdir)/f/runtime/configure \
+  $(srcdir)/f/runtime/libU77/configure
+
+maybe-f2c:
+#For now, omit f2c stuff.  -- burley
+#	case "$(STAGESTUFF)" in *f2c*) $(MAKE) f2c;; esac
+
+# Install hooks:
+# f771 is installed elsewhere as part of $(COMPILERS).
+
+f77.install-normal: install-libf77 install-f2c-all
+
+# Install the F77 run time library.
+install-libf77: f77-runtime
+# Check for the presence of other versions of the library and includes.
+# Test libf2c.* in case of a shared version, for instance.
+	@if test -z "$(F2CLIBOK)" && \
+	   test -z "$(F2C_INSTALL_FLAG)" && \
+	   test "`echo $(libdir)/libf2c.*`" != "$(libdir)/libf2c.*"; then \
+   echo ; \
+   echo 'You already have a version of libf2c installed as' $(libdir)/libf2c.*; \
+   echo 'To use g77 this must be consistent with the one that will be built.'; \
+   echo 'You should probably delete it and/or install ./libf2c.a in its place.'; \
+   echo 'Resume the "make install" after removing the existing library or'; \
+   echo 'define the make variable F2CLIBOK to avoid this test.'; \
+   echo 'Check also for' $(includedir)/f2c.h 'per INSTALL instructions.'; \
+   echo '(Note that a quick and easy way to resume "make -k install" is to'; \
+   echo 'use "make install-libf77".)'; \
+   exit 1; else true; fi
+	if [ -f libf2c.a ] ; then \
+	  $(INSTALL_DATA) libf2c.a $(libsubdir)/libf2c.a; \
+	  if $(RANLIB_TEST) ; then \
+	    (cd $(libsubdir); $(RANLIB) libf2c.a); else true; fi; \
+	  chmod a-x $(libsubdir)/libf2c.a; \
+	else true; fi
+	if [ -f include/f2c.h ] ; then \
+	  $(INSTALL_DATA) include/f2c.h $(libsubdir)/include/f2c.h; \
+	else true; fi
+
+# Install the f2c-related stuff in the directories
+# where f2c and vanilla ld might look for them.
+
+install-f2c-all: install-f2c-header install-f2c-lib
+
+install-f2c-header:
+	-if test -n "$(F2C_INSTALL_FLAG)" && test -f include/f2c.h; then \
+	  $(INSTALL_DATA) include/f2c.h $(includedir)/f2c.h; \
+	  chmod a+r $(includedir)/f2c.h; \
+	else true; fi
+
+install-f2c-lib:
+	-if test -n "$(F2C_INSTALL_FLAG)" && test -f libf2c.a; then \
+	  $(INSTALL_DATA) libf2c.a $(libdir)/libf2c.a; \
+	  if $(RANLIB_TEST) ; then \
+	    (cd $(libdir); $(RANLIB) libf2c.a); else true; fi; \
+	  chmod a-x $(libdir)/libf2c.a; \
+	else true; fi
+
+# Install the driver program as $(target)-g77
+# and also as either g77 (if native) or $(tooldir)/bin/g77.
+f77.install-common:
+	-if [ -f f771$(exeext) ] ; then \
+	  if [ -f g77-cross$(exeext) ] ; then \
+	    rm -f $(bindir)/$(G77_CROSS_NAME)$(exeext); \
+	    $(INSTALL_PROGRAM) g77-cross$(exeext) $(bindir)/$(G77_CROSS_NAME)$(exeext); \
+	    chmod a+x $(bindir)/$(G77_CROSS_NAME)$(exeext); \
+	    if $(F77_INSTALL_FLAG) ; then \
+	      rm -f $(bindir)/$(F77_CROSS_NAME)$(exeext); \
+	      ln $(bindir)/$(G77_CROSS_NAME)$(exeext) $(bindir)/$(F77_CROSS_NAME)$(exeext) \
+		> /dev/null 2>&1 \
+		|| cp $(bindir)/$(G77_CROSS_NAME)$(exeext) $(bindir)/$(F77_CROSS_NAME)$(exeext) ; \
+	    fi ; \
+	  else \
+	    rm -f $(bindir)/$(G77_INSTALL_NAME)$(exeext); \
+	    $(INSTALL_PROGRAM) g77$(exeext) $(bindir)/$(G77_INSTALL_NAME)$(exeext); \
+	    chmod a+x $(bindir)/$(G77_INSTALL_NAME)$(exeext); \
+	    if $(F77_INSTALL_FLAG) ; then \
+	      rm -f $(bindir)/$(F77_INSTALL_NAME)$(exeext); \
+	      ln $(bindir)/$(G77_INSTALL_NAME)$(exeext) $(bindir)/$(F77_INSTALL_NAME)$(exeext) \
+		> /dev/null 2>&1 \
+		|| cp $(bindir)/$(G77_INSTALL_NAME)$(exeext) $(bindir)/$(F77_INSTALL_NAME)$(exeext) ; \
+	    fi ; \
+	  fi ; \
+	else true; fi
+
+f77.install-info:
+	-rm -f $(infodir)/g77.info*
+	cd $(srcdir)/f; for f in g77.info*; \
+	do $(INSTALL_DATA) $$f $(infodir)/$$f; done
+	-chmod a-x $(infodir)/g77.info*
+
+f77.install-man: $(srcdir)/f/g77.1
+	-if [ -f f771$(exeext) ] ; then \
+	  if [ -f g77-cross$(exeext) ] ; then \
+	    rm -f $(mandir)/$(G77_CROSS_NAME)$(manext); \
+	    $(INSTALL_DATA) $(srcdir)/f/g77.1 $(mandir)/$(G77_CROSS_NAME)$(manext); \
+	    chmod a-x $(mandir)/$(G77_CROSS_NAME)$(manext); \
+	    if $(F77_INSTALL_FLAG) ; then \
+	      rm -f $(mandir)/$(F77_CROSS_NAME)$(manext); \
+	      ln $(mandir)/$(G77_CROSS_NAME)$(manext) $(mandir)/$(F77_CROSS_NAME)$(manext) \
+		> /dev/null 2>&1 \
+		|| cp $(mandir)/$(F77_CROSS_NAME)$(manext) $(mandir)/$(F77_CROSS_NAME)$(manext) ; \
+	    fi ;\
+	  else \
+	    rm -f $(mandir)/$(G77_INSTALL_NAME)$(manext); \
+	    $(INSTALL_DATA) $(srcdir)/f/g77.1 $(mandir)/$(G77_INSTALL_NAME)$(manext); \
+	    chmod a-x $(mandir)/$(G77_INSTALL_NAME)$(manext); \
+	    if $(F77_INSTALL_FLAG) ; then \
+	      rm -f $(mandir)/$(F77_INSTALL_NAME)$(manext); \
+	      ln $(mandir)/$(G77_INSTALL_NAME)$(manext) $(mandir)/$(F77_INSTALL_NAME)$(manext) \
+		> /dev/null 2>&1 \
+		|| cp $(mandir)/$(F77_INSTALL_NAME)$(manext) $(mandir)/$(F77_INSTALL_NAME)$(manext) ; \
+	    fi ;\
+	  fi; \
+	else true; fi
+
+f77.uninstall:
+	-if $(F77_INSTALL_FLAG) ; then \
+	  rm -rf $(bindir)/$(F77_INSTALL_NAME)$(exeext) ; \
+	  rm -rf $(bindir)/$(F77_CROSS_NAME)$(exeext) ; \
+	  rm -rf $(mandir)/$(F77_INSTALL_NAME)$(manext) ; \
+	  rm -rf $(mandir)/$(F77_CROSS_NAME)$(manext) ; \
+	fi
+	-rm -rf $(bindir)/$(G77_INSTALL_NAME)$(exeext)
+	-rm -rf $(bindir)/$(G77_CROSS_NAME)$(exeext)
+	-rm -rf $(mandir)/$(G77_INSTALL_NAME)$(manext)
+	-rm -rf $(mandir)/$(G77_CROSS_NAME)$(manext)
+	-rm -rf $(infodir)/g77.info*
+	-rm -rf $(libsubdir)/libf2c.a
+	-if $(F2C_INSTALL_FLAG) ; then \
+	  rm -rf include/f2c.h ; \
+	  rm -rf $(libdir)/libf2c.a ; \
+	fi
+
+# 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/fini f/f771 f/stamp-str f/str-*.h f/str-*.j f/intdoc
+	-cd f/runtime; $(MAKE) -f ../../$(srcdir)/f/runtime/Makefile.in mostlyclean
+f77.clean:
+	-cd f/runtime; $(MAKE) -f ../../$(srcdir)/f/runtime/Makefile.in clean
+f77.distclean:
+	-cd f/runtime; $(MAKE) -f ../../$(srcdir)/f/runtime/Makefile.in distclean
+	-rm -f f/Makefile
+# like gcc's extraclean, which does clean f/ for us, but not f/gbe,
+# f/runtime, f/runtime/libF77, f/runtime/libI77, and f/runtime/libU77,
+# so do those.
+f77.extraclean: f77.distclean
+	-rm -f f/*/=* f/*/"#"* f/*/*~*
+	-rm -f f/*/patch* f/*/*.orig f/*/*.rej
+	-rm -f f/*/*.dvi f/*/*.oaux f/*/*.d f/*/*.[zZ] f/*/*.gz
+	-rm -f f/*/*.tar f/*/*.xtar f/*/*diff f/*/*.diff.* f/*/*.tar.* f/*/*.xtar.* f/*/*diffs
+	-rm -f f/*/*lose f/*/*.s f/*/*.s[0-9] f/*/*.i
+	-rm -f f/*/*/=* f/*/*/"#"* f/*/*/*~*
+	-rm -f f/*/*/patch* f/*/*/*.orig f/*/*/*.rej
+	-rm -f f/*/*/*.dvi f/*/*/*.oaux f/*/*/*.d f/*/*/*.[zZ] f/*/*/*.gz
+	-rm -f f/*/*/*.tar f/*/*/*.xtar f/*/*/*diff f/*/*/*.diff.* f/*/*/*.tar.* f/*/*/*.xtar.* f/*/*/*diffs
+	-rm -f f/*/*/*lose f/*/*/*.s f/*/*/*.s[0-9] f/*/*/*.i
+# realclean is the pre-2.7.0 name for maintainer-clean
+f77.maintainer-clean f77.realclean: f77.distclean
+	-cd f/runtime; $(MAKE) -f ../../$(srcdir)/f/runtime/Makefile.in maintainer-clean
+	-$(MAKE) f77.maintainer-clean
+	-rm -f f/g77.info* f/g77.*aux f/TAGS f/BUGS f/INSTALL f/NEWS f/intdoc.texi
+
+# Stage hooks:
+# The main makefile has already created stage?/f.
+
+G77STAGESTUFF = f/*$(objext) f/fini f/stamp-str f/str-*.h f/str-*.j
+RUNTIMESTAGESTUFF = f/runtime/config.cache f/runtime/config.log \
+  f/runtime/config.status f/runtime/Makefile f/runtime/stamp-lib
+LIBF77STAGESTUFF = f/runtime/libF77/*$(objext) f/runtime/libF77/Makefile
+LIBI77STAGESTUFF = f/runtime/libI77/*$(objext) f/runtime/libI77/Makefile
+LIBU77STAGESTUFF = f/runtime/libU77/*$(objext) f/runtime/libU77/Makefile \
+  f/runtime/libU77/config.cache f/runtime/libU77/config.log \
+  f/runtime/libU77/config.status
+
+f77.stage1:
+	-mv $(G77STAGESTUFF) stage1/f
+	-mv $(RUNTIMESTAGESTUFF) stage1/f/runtime
+	-mv $(LIBF77STAGESTUFF) stage1/f/runtime/libF77
+	-mv $(LIBI77STAGESTUFF) stage1/f/runtime/libI77
+	-mv $(LIBU77STAGESTUFF) stage1/f/runtime/libU77
+f77.stage2:
+	-mv $(G77STAGESTUFF) stage2/f
+	-mv $(RUNTIMESTAGESTUFF) stage2/f/runtime
+	-mv $(LIBF77STAGESTUFF) stage2/f/runtime/libF77
+	-mv $(LIBI77STAGESTUFF) stage2/f/runtime/libI77
+	-mv $(LIBU77STAGESTUFF) stage2/f/runtime/libU77
+f77.stage3:
+	-mv $(G77STAGESTUFF) stage3/f
+	-mv $(RUNTIMESTAGESTUFF) stage3/f/runtime
+	-mv $(LIBF77STAGESTUFF) stage3/f/runtime/libF77
+	-mv $(LIBI77STAGESTUFF) stage3/f/runtime/libI77
+	-mv $(LIBU77STAGESTUFF) stage3/f/runtime/libU77
+f77.stage4:
+	-mv $(G77STAGESTUFF) stage4/f
+	-mv $(RUNTIMESTAGESTUFF) stage4/f/runtime
+	-mv $(LIBF77STAGESTUFF) stage4/f/runtime/libF77
+	-mv $(LIBI77STAGESTUFF) stage4/f/runtime/libI77
+	-mv $(LIBU77STAGESTUFF) stage4/f/runtime/libU77
+
+# Maintenance hooks:
+
+# This target creates the files that can be rebuilt, but go in the
+# distribution anyway.  It then copies the files to the distdir directory.
+f77.distdir: f77.rebuilt
+	mkdir tmp/f
+	cd f; \
+	for file in *[0-9a-zA-Z+]; do \
+	  ln $$file ../tmp/f >/dev/null 2>&1 || cp $$file ../tmp/f; \
+	done
diff --git a/gcc/f/Makefile.in b/gcc/f/Makefile.in
new file mode 100644
index 00000000000..79eba82a3a9
--- /dev/null
+++ b/gcc/f/Makefile.in
@@ -0,0 +1,562 @@
+# Makefile for GNU F77 compiler.
+#   Copyright (C) 1995-1997 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.
+
+# The makefile built from this file lives in the language subdirectory.
+# Its purpose is to provide support for:
+#
+# 1) recursion where necessary, and only then (building .o's), and
+# 2) building and debugging f771 from the language subdirectory, and
+# 3) nothing else.
+#
+# The parent makefile handles all other chores, with help from the
+# language makefile fragment, of course.
+#
+# The targets for external use are:
+# all, TAGS, ???mostlyclean, ???clean.
+
+# Suppress smart makes who think they know how to automake Yacc files
+.y.c:
+
+# Variables that exist for you to override.
+# See below for how to change them for certain systems.
+
+ALLOCA =
+
+# Various ways of specifying flags for compilations:
+# CFLAGS is for the user to override to, e.g., do a bootstrap with -O2.
+# BOOT_CFLAGS is the value of CFLAGS to pass
+# to the stage2 and stage3 compilations
+# XCFLAGS is used for most compilations but not when using the GCC just built.
+XCFLAGS =
+CFLAGS = -g
+BOOT_CFLAGS = -O $(CFLAGS)
+# These exists to be overridden by the x-* and t-* files, respectively.
+X_CFLAGS =
+T_CFLAGS =
+
+X_CPPFLAGS =
+T_CPPFLAGS =
+
+CC = cc
+HOST_CC = $(CC)
+BISON = bison
+BISONFLAGS =
+LEX = flex
+LEXFLAGS =
+AR = ar
+AR_FLAGS = rc
+SHELL = /bin/sh
+MAKEINFO = makeinfo
+TEXI2DVI = texi2dvi
+
+# Define this as & to perform parallel make on a Sequent.
+# Note that this has some bugs, and it seems currently necessary
+# to compile all the gen* files first by hand to avoid erroneous results.
+P =
+
+# This is used in the definition of SUBDIR_USE_ALLOCA.
+# ??? Perhaps it would be better if it just looked for *gcc*.
+OLDCC = cc
+
+# This is used instead of ALL_CFLAGS when compiling with GCC_FOR_TARGET.
+# It omits XCFLAGS, and specifies -B./.
+# It also specifies -B$(tooldir)/ to find as and ld for a cross compiler.
+GCC_CFLAGS=$(INTERNAL_CFLAGS) $(X_CFLAGS) $(T_CFLAGS) $(CFLAGS)
+
+# Tools to use when building a cross-compiler.
+# These are used because `configure' appends `cross-make'
+# to the makefile when making a cross-compiler.
+
+target= ... `configure' substitutes actual target name here.
+xmake_file= ... `configure' substitutes actual x- file name here.
+tmake_file= ... `configure' substitutes actual t- file name here.
+
+# Directory where gcc sources are (gcc/), from where we are.
+# Note that this should be overridden when building f771, which happens
+# at the top level, not in f.  Likewise for VPATH (if added).
+srcdir = .
+VPATH = .
+
+# Additional system libraries to link with.
+CLIB=
+
+# Change this to a null string if obstacks are installed in the
+# system library.
+OBSTACK=obstack.o
+
+# Choose the real default target.
+ALL=all
+
+# End of variables for you to override.
+
+# Definition of `none' is here so that new rules inserted by sed
+# do not specify the default target.
+none:
+	@echo ''
+	@echo 'Do not use this makefile to build anything other than the'
+	@echo 'g77 derived files via the "make g77-only" target.'
+	@echo 'Instead, use the documented procedures to build gcc itself,'
+	@echo 'which will build g77 as well when done properly.'
+	@echo ''
+	@exit 1
+
+# This rule is just a handy way to build the g77 derived files without
+# having the gcc source tree around.
+g77-only: force
+	if [ -f g77.texi ] ; then \
+	  (cd ..; $(MAKE) srcdir=. HOST_CC=cc HOST_CFLAGS=-g -f f/Make-lang.in f77.rebuilt); \
+	else \
+	  $(MAKE) srcdir=. HOST_CC=cc HOST_CFLAGS=-g -f f/Make-lang.in f77.rebuilt; \
+	fi
+
+all: all.indirect
+
+# This tells GNU Make version 3 not to put all variables in the environment.
+.NOEXPORT:
+
+# sed inserts variable overrides after the following line.
+####target overrides
+####host overrides
+####cross overrides
+####build overrides
+
+# Now figure out from those variables how to compile and link.
+
+all.indirect: f/Makefile f771
+
+# IN_GCC tells obstack.h that we are using gcc's <stddef.h> file.
+INTERNAL_CFLAGS = $(CROSS) -DIN_GCC
+
+# This is the variable actually used when we compile.
+ALL_CFLAGS = $(INTERNAL_CFLAGS) $(X_CFLAGS) $(T_CFLAGS) $(CFLAGS) $(XCFLAGS) -W -Wall
+
+# Likewise.
+ALL_CPPFLAGS = $(CPPFLAGS) $(X_CPPFLAGS) $(T_CPPFLAGS)
+
+# f771 is so big, need to tell linker on m68k-next-nextstep* to make enough
+# room for it.  On AIX, linking f771 overflows the linker TOC.  -bbigtoc is
+# appropriate for the linker on AIX 4.1 and above.
+F771_LDFLAGS = `case "${target}" in\
+ m68k-next-nextstep*) echo -segaddr __DATA 6000000;;\
+ *-*-aix[4-9]*) \`$(CC) --print-prog-name=ld\` -v 2>&1 | grep BFD >/dev/null || echo -Wl,-bbigtoc;; esac`
+
+# Even if ALLOCA is set, don't use it if compiling with GCC.
+
+SUBDIR_OBSTACK = `if [ x$(OBSTACK) != x ]; then echo $(OBSTACK); else true; fi`
+SUBDIR_USE_ALLOCA = `case "${CC}" in "${OLDCC}") if [ x$(ALLOCA) != x ]; then echo $(ALLOCA); else true; fi ;; esac`
+SUBDIR_MALLOC = `if [ x$(MALLOC) != x ]; then echo $(MALLOC); else true; fi`
+
+# How to link with both our special library facilities
+# and the system's installed libraries.
+LIBS = $(SUBDIR_OBSTACK) $(SUBDIR_USE_ALLOCA) $(SUBDIR_MALLOC) $(CLIB)
+
+# Specify the directories to be searched for header files.
+# Both . and srcdir are used, in that order,
+# so that tm.h and config.h will be found in the compilation
+# directory rather than in the source directory.
+INCLUDES = -If -I$(srcdir)/f -I. -I$(srcdir) -I$(srcdir)/config
+
+# Flags_to_pass to recursive makes.
+# Note that we don't need to distinguish the `_FOR_TARGET' cross tools
+# as AR and RANLIB are set appropriately by configure iff cross compiling.
+FLAGS_TO_PASS = \
+	"CROSS=$(CROSS)" \
+	"AR_FLAGS=$(AR_FLAGS)" \
+	"AR=$(AR)" \
+	"BISON=$(BISON)" \
+	"BISONFLAGS=$(BISONFLAGS)" \
+	"CC=$(CC)" \
+	"CFLAGS=$(CFLAGS)" \
+	"GCCFLAGS=$(GCCFLAGS)" \
+	"GCC_FOR_TARGET=$(GCC_FOR_TARGET)" \
+	"LDFLAGS=$(LDFLAGS)" \
+	"LEX=$(LEX)" \
+	"LEXFLAGS=$(LEXFLAGS)" \
+	"MAKEINFO=$(MAKEINFO)" \
+	"MAKEINFOFLAGS=$(MAKEINFOFLAGS)" \
+	"RANLIB=$(RANLIB)" \
+	"RANLIB_TEST=$(RANLIB_TEST)" \
+	"SHELL=$(SHELL)" \
+	"exec_prefix=$(exec_prefix)" \
+	"prefix=$(prefix)" \
+	"tooldir=$(tooldir)" \
+	"bindir=$(bindir)" \
+	"libsubdir=$(libsubdir)"
+
+.c.o:
+	$(CC) -c $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) $< -o $@
+
+# Lists of files for various purposes.
+
+# Language-specific object files for g77
+
+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/proj.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 \
+ f/zzz.o
+
+# Language-independent object files.
+OBJS = `cat stamp-objlist | sed -e "s:  : :g" -e "s: : f/:g"`
+OBJDEPS = stamp-objlist
+
+compiler: f771
+# This is now meant to be built in the top level directory, not `f':
+f771: $(P) f/Makefile $(F77_OBJS) $(OBJDEPS) $(LIBDEPS)
+	rm -f f771$(exeext)
+	$(CC) $(ALL_CFLAGS) $(LDFLAGS) $(F771_LDFLAGS) -o $@ \
+	      $(F77_OBJS) $(OBJS) $(LIBS)
+
+# Check in case anyone expects to build in this directory:
+f/Makefile:
+	@if test ! -f f/Makefile ; \
+	then echo "Build f771 only at the top level." 2>&1; exit 1; \
+	else true; fi
+
+Makefile: $(srcdir)/f/Makefile.in $(srcdir)/configure
+
+native: f771
+
+# Compiling object files from source files.
+
+# Note that dependencies on obstack.h are not written
+# because that file is not part of GCC.
+
+# F77 language-specific files.
+
+# These macros expand to the corresponding g77-source .j files plus
+# the gcc-source files involved (each file itself, plus whatever
+# files on which it depends, but without including stuff resulting
+# from configuration, since we can't guess at that).  The files
+# that live in a distclean'd gcc source directory have "$(srcdir)/"
+# prefixes, while the others don't because they'll be created
+# only in the build directory.
+ASSERT_H = $(srcdir)/f/assert.j $(srcdir)/assert.h
+CONFIG_H = $(srcdir)/f/config.j config.h
+CONVERT_H = $(srcdir)/f/convert.j $(srcdir)/convert.h
+FLAGS_H = $(srcdir)/f/flags.j $(srcdir)/flags.h
+GLIMITS_H = $(srcdir)/f/glimits.j $(srcdir)/glimits.h
+HCONFIG_H = $(srcdir)/f/hconfig.j hconfig.h
+INPUT_H = $(srcdir)/f/input.j $(srcdir)/input.h
+RTL_H = $(srcdir)/f/rtl.j $(srcdir)/rtl.h $(srcdir)/rtl.def \
+	$(srcdir)/machmode.h $(srcdir)/machmode.def
+TCONFIG_H = $(srcdir)/f/tconfig.j tconfig.h
+TM_H = $(srcdir)/f/tm.j tm.h
+TREE_H = $(srcdir)/f/tree.j $(srcdir)/tree.h $(srcdir)/real.h \
+	$(srcdir)/tree.def $(srcdir)/machmode.h $(srcdir)/machmode.def
+
+#Build the first part of this list with the command line:
+#    cd gcc/; make deps-kinda -f f/Makefile.in
+#Note that this command uses the host C compiler;
+# use HOST_CC="./xgcc -B./" to use GCC in the build directory, for example.
+#Also note that this particular build file seems to want to use
+# substitions: $(CONFIG_H) for config.h; $(TREE_H) for tree.h; and
+# $(RTL_H) for rtl.h.  deps-kinda uses a sed script to do those
+# substitutions, plus others for elegance.
+
+f/bad.o: f/bad.c f/proj.h $(ASSERT_H) f/bad.h f/bad.def f/where.h $(GLIMITS_H) \
+  f/top.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/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/bit.o: f/bit.c f/proj.h $(ASSERT_H) $(GLIMITS_H) f/bit.h f/malloc.h
+f/bld.o: f/bld.c f/proj.h $(ASSERT_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/com.o: f/com.c $(CONFIG_H) $(FLAGS_H) $(RTL_H) $(TREE_H) $(CONVERT_H) f/proj.h \
+  $(ASSERT_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
+f/data.o: f/data.c f/proj.h $(ASSERT_H) f/data.h f/bld.h f/bld-op.def f/bit.h \
+  f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def \
+  f/info-w.def f/target.h f/bad.h f/bad.def f/where.h $(GLIMITS_H) f/top.h f/lex.h \
+  f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h f/global.h \
+  f/name.h f/intrin.h f/intrin.def f/expr.h f/st.h
+f/equiv.o: f/equiv.c f/proj.h $(ASSERT_H) f/equiv.h f/bld.h f/bld-op.def f/bit.h \
+  f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def \
+  f/info-w.def f/target.h f/bad.h f/bad.def f/where.h $(GLIMITS_H) f/top.h f/lex.h \
+  f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def f/global.h f/name.h \
+  f/intrin.h f/intrin.def f/data.h
+f/expr.o: f/expr.c f/proj.h $(ASSERT_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/fini.o: f/fini.c f/proj.h $(ASSERT_H) f/malloc.h
+f/g77.o: f/g77.c $(CONFIG_H)
+f/global.o: f/global.c f/proj.h $(ASSERT_H) f/global.h f/lex.h f/top.h f/malloc.h \
+  f/where.h $(GLIMITS_H) f/name.h f/symbol.h f/symbol.def f/bad.h f/bad.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/implic.o: f/implic.c f/proj.h $(ASSERT_H) f/implic.h f/info.h f/info-b.def \
+  f/info-k.def f/info-w.def f/target.h $(TREE_H) f/bad.h f/bad.def f/where.h \
+  $(GLIMITS_H) f/top.h f/malloc.h f/lex.h f/type.h f/symbol.h f/symbol.def f/bld.h \
+  f/bld-op.def f/bit.h f/com.h f/com-rt.def f/lab.h f/storag.h f/intrin.h \
+  f/intrin.def f/equiv.h f/global.h f/name.h f/src.h
+f/info.o: f/info.c f/proj.h $(ASSERT_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/intrin.o: f/intrin.c f/proj.h $(ASSERT_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/src.h
+f/lab.o: f/lab.c f/proj.h $(ASSERT_H) f/lab.h f/com.h f/com-rt.def $(TREE_H) f/bld.h \
+  f/bld-op.def f/bit.h f/malloc.h f/info.h f/info-b.def f/info-k.def \
+  f/info-w.def f/target.h f/bad.h f/bad.def f/where.h $(GLIMITS_H) f/top.h f/lex.h \
+  f/type.h f/intrin.h f/intrin.def f/symbol.h f/symbol.def f/equiv.h f/storag.h \
+  f/global.h f/name.h
+f/lex.o: f/lex.c f/proj.h $(ASSERT_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 $(CONFIG_H) $(FLAGS_H) $(INPUT_H)
+f/malloc.o: f/malloc.c f/proj.h $(ASSERT_H) f/malloc.h
+f/name.o: f/name.c f/proj.h $(ASSERT_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/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/src.h
+f/parse.o: f/parse.c f/proj.h $(ASSERT_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 f/zzz.h $(FLAGS_H)
+f/proj.o: f/proj.c f/proj.h $(ASSERT_H) $(GLIMITS_H)
+f/src.o: f/src.c f/proj.h $(ASSERT_H) f/src.h f/bad.h f/bad.def f/where.h \
+  $(GLIMITS_H) f/top.h f/malloc.h
+f/st.o: f/st.c f/proj.h $(ASSERT_H) f/st.h f/bad.h f/bad.def f/where.h $(GLIMITS_H) \
+  f/top.h f/malloc.h f/lex.h f/symbol.h f/symbol.def f/bld.h f/bld-op.def f/bit.h \
+  f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def f/info-w.def \
+  f/target.h f/type.h f/lab.h f/storag.h f/intrin.h f/intrin.def f/equiv.h \
+  f/global.h f/name.h f/sta.h f/stamp-str f/stb.h f/expr.h f/stp.h f/stt.h f/stc.h \
+  f/std.h f/stv.h f/stw.h f/ste.h f/sts.h f/stu.h
+f/sta.o: f/sta.c f/proj.h $(ASSERT_H) f/sta.h f/bad.h f/bad.def f/where.h \
+  $(GLIMITS_H) f/top.h f/malloc.h f/lex.h f/stamp-str f/symbol.h f/symbol.def f/bld.h \
+  f/bld-op.def f/bit.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def \
+  f/info-k.def f/info-w.def f/target.h f/type.h f/lab.h f/storag.h f/intrin.h \
+  f/intrin.def f/equiv.h f/global.h f/name.h f/implic.h f/stb.h f/expr.h f/stp.h \
+  f/stt.h f/stc.h f/std.h f/stv.h f/stw.h
+f/stb.o: f/stb.c f/proj.h $(ASSERT_H) f/stb.h f/bad.h f/bad.def f/where.h \
+  $(GLIMITS_H) f/top.h f/malloc.h f/expr.h f/bld.h f/bld-op.def f/bit.h f/com.h \
+  f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def f/info-w.def \
+  f/target.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def \
+  f/equiv.h f/global.h f/name.h f/intrin.h f/intrin.def f/stp.h f/stt.h f/stamp-str \
+  f/src.h f/sta.h f/stc.h
+f/stc.o: f/stc.c f/proj.h $(ASSERT_H) f/stc.h f/bad.h f/bad.def f/where.h \
+  $(GLIMITS_H) f/top.h f/malloc.h f/bld.h f/bld-op.def f/bit.h f/com.h \
+  f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def f/info-w.def \
+  f/target.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def \
+  f/equiv.h f/global.h f/name.h f/intrin.h f/intrin.def f/expr.h f/stp.h f/stt.h \
+  f/stamp-str f/data.h f/implic.h f/src.h f/sta.h f/std.h f/stv.h f/stw.h
+f/std.o: f/std.c f/proj.h $(ASSERT_H) f/std.h f/bld.h f/bld-op.def f/bit.h \
+  f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def \
+  f/info-w.def f/target.h f/bad.h f/bad.def f/where.h $(GLIMITS_H) f/top.h f/lex.h \
+  f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h f/global.h \
+  f/name.h f/intrin.h f/intrin.def f/stp.h f/stt.h f/stamp-str f/stv.h f/stw.h f/sta.h \
+  f/ste.h f/sts.h
+f/ste.o: f/ste.c $(CONFIG_H) $(RTL_H) f/proj.h $(ASSERT_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/sta.h
+f/storag.o: f/storag.c f/proj.h $(ASSERT_H) f/storag.h f/bld.h f/bld-op.def f/bit.h \
+  f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def \
+  f/info-w.def f/target.h f/bad.h f/bad.def f/where.h $(GLIMITS_H) f/top.h f/lex.h \
+  f/type.h f/lab.h f/symbol.h f/symbol.def f/equiv.h f/global.h f/name.h \
+  f/intrin.h f/intrin.def f/data.h
+f/stp.o: f/stp.c f/proj.h $(ASSERT_H) f/stp.h f/bld.h f/bld-op.def f/bit.h \
+  f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def \
+  f/info-w.def f/target.h f/bad.h f/bad.def f/where.h $(GLIMITS_H) f/top.h f/lex.h \
+  f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h f/global.h \
+  f/name.h f/intrin.h f/intrin.def f/stt.h
+f/str.o: f/str.c f/proj.h $(ASSERT_H) f/src.h f/bad.h f/bad.def f/where.h \
+  $(GLIMITS_H) f/top.h f/malloc.h f/stamp-str f/lex.h
+f/sts.o: f/sts.c f/proj.h $(ASSERT_H) f/sts.h f/malloc.h f/com.h f/com-rt.def \
+  $(TREE_H) f/bld.h f/bld-op.def f/bit.h f/info.h f/info-b.def f/info-k.def \
+  f/info-w.def f/target.h f/bad.h f/bad.def f/where.h $(GLIMITS_H) f/top.h f/lex.h \
+  f/type.h f/intrin.h f/intrin.def f/lab.h f/symbol.h f/symbol.def f/equiv.h \
+  f/storag.h f/global.h f/name.h
+f/stt.o: f/stt.c f/proj.h $(ASSERT_H) f/stt.h f/top.h f/malloc.h f/where.h \
+  $(GLIMITS_H) f/bld.h f/bld-op.def f/bit.h f/com.h f/com-rt.def $(TREE_H) f/info.h \
+  f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def f/lex.h \
+  f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h f/global.h \
+  f/name.h f/intrin.h f/intrin.def f/stp.h f/expr.h f/sta.h f/stamp-str
+f/stu.o: f/stu.c f/proj.h $(ASSERT_H) f/bld.h f/bld-op.def f/bit.h f/malloc.h \
+  f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def f/info-w.def \
+  f/target.h f/bad.h f/bad.def f/where.h $(GLIMITS_H) f/top.h f/lex.h f/type.h \
+  f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h f/global.h f/name.h \
+  f/intrin.h f/intrin.def f/implic.h f/stu.h f/sta.h f/stamp-str
+f/stv.o: f/stv.c f/proj.h $(ASSERT_H) f/stv.h f/lab.h f/com.h f/com-rt.def $(TREE_H) \
+  f/bld.h f/bld-op.def f/bit.h f/malloc.h f/info.h f/info-b.def f/info-k.def \
+  f/info-w.def f/target.h f/bad.h f/bad.def f/where.h $(GLIMITS_H) f/top.h f/lex.h \
+  f/type.h f/intrin.h f/intrin.def f/symbol.h f/symbol.def f/equiv.h f/storag.h \
+  f/global.h f/name.h
+f/stw.o: f/stw.c f/proj.h $(ASSERT_H) f/stw.h f/bld.h f/bld-op.def f/bit.h \
+  f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def \
+  f/info-w.def f/target.h f/bad.h f/bad.def f/where.h $(GLIMITS_H) f/top.h f/lex.h \
+  f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h f/global.h \
+  f/name.h f/intrin.h f/intrin.def f/stv.h f/sta.h f/stamp-str
+f/symbol.o: f/symbol.c f/proj.h $(ASSERT_H) f/symbol.h f/symbol.def 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/intrin.h f/intrin.def \
+  f/equiv.h f/global.h f/name.h f/src.h f/st.h
+f/target.o: f/target.c f/proj.h $(ASSERT_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 f/info-b.def f/info-k.def \
+  f/info-w.def f/type.h f/lex.h
+f/top.o: f/top.c f/proj.h $(ASSERT_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)
+f/type.o: f/type.c f/proj.h $(ASSERT_H) f/type.h f/malloc.h
+f/where.o: f/where.c f/proj.h $(ASSERT_H) f/where.h $(GLIMITS_H) f/top.h f/malloc.h \
+  f/lex.h
+f/zzz.o: f/zzz.c f/proj.h $(ASSERT_H) f/zzz.h
+
+# The rest of this list (Fortran 77 language-specific files) is hand-generated.
+
+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
+	touch f/stamp-str
+
+f/str-1t.h f/str-1t.j: f/fini f/str-1t.fin
+	./f/fini `echo $(srcdir)/f/str-1t.fin | sed 's,^\./,,'` f/str-1t.j f/str-1t.h
+
+f/str-2t.h f/str-2t.j: f/fini f/str-2t.fin
+	./f/fini `echo $(srcdir)/f/str-2t.fin | sed 's,^\./,,'` f/str-2t.j f/str-2t.h
+
+f/str-fo.h f/str-fo.j: f/fini f/str-fo.fin
+	./f/fini `echo $(srcdir)/f/str-fo.fin | sed 's,^\./,,'` f/str-fo.j f/str-fo.h
+
+f/str-io.h f/str-io.j: f/fini f/str-io.fin
+	./f/fini `echo $(srcdir)/f/str-io.fin | sed 's,^\./,,'` f/str-io.j f/str-io.h
+
+f/str-nq.h f/str-nq.j: f/fini f/str-nq.fin
+	./f/fini `echo $(srcdir)/f/str-nq.fin | sed 's,^\./,,'` f/str-nq.j f/str-nq.h
+
+f/str-op.h f/str-op.j: f/fini f/str-op.fin
+	./f/fini `echo $(srcdir)/f/str-op.fin | sed 's,^\./,,'` f/str-op.j f/str-op.h
+
+f/str-ot.h f/str-ot.j: f/fini f/str-ot.fin
+	./f/fini `echo $(srcdir)/f/str-ot.fin | sed 's,^\./,,'` f/str-ot.j f/str-ot.h
+
+f/fini: f/fini.o f/proj-h.o
+	$(HOST_CC) $(HOST_CFLAGS) -W -Wall $(HOST_LDFLAGS) -o f/fini f/fini.o f/proj-h.o
+
+f/fini.o:
+	$(HOST_CC) -c $(HOST_CFLAGS) $(HOST_CPPFLAGS) $(INCLUDES) \
+	      `echo $(srcdir)/f/fini.c | sed 's,^\./,,'` -o $@
+
+f/proj-h.o: f/proj.o
+	$(HOST_CC) -c $(HOST_CFLAGS) $(HOST_CPPFLAGS) $(INCLUDES) \
+	      `echo $(srcdir)/f/proj.c | sed 's,^\./,,'` -o $@
+
+# Other than str-*.j, the *.j files are dummy #include files
+# that normally just #include the corresponding back-end *.h
+# files, but not if MAKING_DEPENDENCIES is #defined.  The str-*.j
+# files also are not actually included if MAKING_DEPENDENCIES
+# is #defined.  The point of all this is to come up with a clean
+# dependencies list whether working in a clean directory, such
+# that str-*.j and such do not exist, or in a directory full
+# of already-built files.  Any dependency on a str-*.j file
+# implies a dependency on str.h, so we key on that to replace
+# it with stamp-str, and dependencies on the other *.j files
+# are generally left alone (modulo special macros like RTL_H)
+# because we might not want to recompile all of g77 just
+# because a back-end file changes.  MG is usually "-MG" but
+# should be defined with "make MG= deps-kinda..." if using
+# a compiler that doesn't support -MG (gcc does as of 2.6) --
+# it prevents diagnostics when an #include file is missing,
+# as will be the case with proj.h in a clean directory.
+MG=-MG
+deps-kinda:
+	$(HOST_CC) -DMAKING_DEPENDENCIES -MM $(MG) -I -If f/*.c | \
+	  sed -e 's: \([.]/\)*f/assert[.]j: $$(ASSERT_H):g' \
+	      -e 's: \([.]/\)*f/config[.]j: $$(CONFIG_H):g' \
+	      -e 's: \([.]/\)*f/convert[.]j: $$(CONVERT_H):g' \
+	      -e 's: \([.]/\)*f/flags[.]j: $$(FLAGS_H):g' \
+	      -e 's: \([.]/\)*f/glimits[.]j: $$(GLIMITS_H):g' \
+	      -e 's: \([.]/\)*f/hconfig[.]j: $$(HCONFIG_H):g' \
+	      -e 's: \([.]/\)*f/input[.]j: $$(INPUT_H):g' \
+	      -e 's: \([.]/\)*f/rtl[.]j: $$(RTL_H):g' \
+	      -e 's: \([.]/\)*f/tconfig[.]j: $$(TCONFIG_H):g' \
+	      -e 's: \([.]/\)*f/tm[.]j: $$(TM_H):g' \
+	      -e 's: \([.]/\)*f/tree[.]j: $$(TREE_H):g' \
+	      -e 's: proj[.]h: f/proj.h:g' \
+	      -e 's: \([.]/\)*f/str[.]h: f/stamp-str:g' \
+	      -e 's%^\(.*\)[ ]*: %f/\1: %g'
+
+
+# These exist for maintenance purposes.
+
+# Update the tags table.
+TAGS: force
+	cd $(srcdir)/f ;			\
+	etags *.c *.h ;				\
+	echo 'l' | tr 'l' '\f' >> TAGS ;	\
+	echo 'parse.y,0' >> TAGS ; 		\
+	etags -a ../*.h ../*.c;
+
+.PHONY: none all all.indirect f77.rebuilt compiler native deps-kinda TAGS g77-only
+
+force:
diff --git a/gcc/f/NEWS b/gcc/f/NEWS
new file mode 100644
index 00000000000..40fea330e5d
--- /dev/null
+++ b/gcc/f/NEWS
@@ -0,0 +1,1064 @@
+This file lists recent changes to the GNU Fortran compiler.  Copyright
+(C) 1995, 1996 Free Software Foundation, Inc.  You may copy,
+distribute, and modify it freely as long as you preserve this copyright
+notice and permission notice.
+
+News About GNU Fortran
+**********************
+
+   Changes made to recent versions of GNU Fortran are listed below,
+with the most recent version first.
+
+   The changes are generally listed with code-generation bugs first,
+followed by compiler crashes involving valid code, new features, fixes
+to existing features, new diagnostics, internal improvements, and
+miscellany.  This order is not strict--for example, some items involve
+a combination of these elements.
+
+In 0.5.21:
+==========
+
+   * Fix a code-generation bug introduced by 0.5.20 caused by loop
+     unrolling (by specifying `-funroll-loops' or similar).  This bug
+     afflicted all code compiled by version 2.7.2.2.f.2 of `gcc' (C,
+     C++, Fortran, and so on).
+
+   * Fix a code-generation bug manifested when combining local
+     `EQUIVALENCE' with a `DATA' statement that follows the first
+     executable statement (or is treated as an executable-context
+     statement as a result of using the `-fpedantic' option).
+
+   * Fix a compiler crash that occured when an integer division by a
+     constant zero is detected.  Instead, when the `-W' option is
+     specified, the `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
+     `gcc' (C, C++, Fortran, and so on).
+
+   * Fix a compiler crash that occurred in some cases of procedure
+     inlining.  (Such cases became more frequent in 0.5.20.)
+
+   * Fix a compiler crash resulting from using `DATA' or similar to
+     initialize a `COMPLEX' variable or array to zero.
+
+   * Fix compiler crashes involving use of `AND', `OR', or `XOR'
+     intrinsics.
+
+   * Fix compiler bug triggered when using a `COMMON' or `EQUIVALENCE'
+     variable as the target of an `ASSIGN' or assigned-`GOTO' statement.
+
+   * Fix compiler crashes due to using the name of a some non-standard
+     intrinsics (such as `FTELL' or `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.
+
+   * Place automatic arrays on the stack, even if `SAVE' or the
+     `-fno-automatic' option is in effect.  This avoids a compiler
+     crash in some cases.
+
+   * New 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 `g77'.
+
+   * New 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 `-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.
+
+   * 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.
+
+   * Improve performance of the `gcc' back end so certain complicated
+     expressions involving `COMPLEX' arithmetic (especially
+     multiplication) don't appear to take forever to compile.
+
+   * Fix a couple of profiling-related bugs in `gcc' back end.
+
+   * Integrate GNU Ada's (GNAT's) changes to the back end, which
+     consist almost entirely of bug fixes.
+
+   * Include some other `gcc' fixes that seem useful in `g77''s version
+     of `gcc'.  (See `gcc/ChangeLog' for details--compare it to that
+     file in the vanilla `gcc-2.7.2.2.tar.gz' distribution.)
+
+   * Fix `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 (`CHAR(0)') to the significant
+     trailing blanks.
+
+   * Fix `CHMOD' intrinsic to work with file names that have embedded
+     blanks, commas, and so on.
+
+   * Fix `SIGNAL' intrinsic so it accepts an optional third `Status'
+     argument.
+
+   * Fix `IDATE()' intrinsic subroutine (VXT form) so it accepts
+     arguments in the correct order.  Documentation fixed accordingly,
+     and for `GMTIME()' and `LTIME()' as well.
+
+   * Make many changes to `libU77' intrinsics to support existing code
+     more directly.
+
+     Such changes include allowing both subroutine and function forms
+     of many routines, changing `MCLOCK()' and `TIME()' to return
+     `INTEGER(KIND=1)' values, introducing `MCLOCK8()' and `TIME8()' to
+     return `INTEGER(KIND=2)' values, and placing functions that are
+     intended to perform side effects in a new intrinsic group,
+     `badu77'.
+
+   * Improve `libU77' so it is more portable.
+
+   * Add options `-fbadu77-intrinsics-delete',
+     `-fbadu77-intrinsics-hide', and so on.
+
+   * Fix crashes involving diagnosed or invalid code.
+
+   * `g77' and `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.
+
+   * Improve alias analysis code to properly handle output registers
+     (such as the `%o' registers on the SPARC).
+
+   * Add support for `restrict' keyword in `gcc' front end.
+
+   * Modify `make' rules and related code so that generation of Info
+     documentation doesn't require compilation using `gcc'.
+
+   * Add `INT2' and `INT8' intrinsics.
+
+   * Add `CPU_TIME' intrinsic.
+
+   * Add `ALARM' intrinsic.
+
+   * `CTIME' intrinsic now accepts any `INTEGER' argument, not just
+     `INTEGER(KIND=2)'.
+
+   * Warn when explicit type declaration disagrees with the type of an
+     intrinsic invocation.
+
+   * Support `*f771' entry in `gcc' `specs' file.
+
+   * Fix typo in `make' rule `g77-cross', used only for cross-compiling.
+
+   * Fix `libf2c' build procedure to re-archive library if previous
+     attempt to archive was interrupted.
+
+   * Fix `gcc' to more easily support configuring on Pentium Pro (686)
+     systems.
+
+   * Change `gcc' to unroll loops only during the last invocation (of
+     as many as two invocations) of loop optimization.
+
+   * Improve handling of `-fno-f2c' so that code that attempts to pass
+     an intrinsic as an actual argument, such as `CALL FOO(ABS)', is
+     rejected due to the fact that the run-time-library routine is,
+     effectively, compiled with `-ff2c' in effect.
+
+   * Fix `g77' driver to recognize `-fsyntax-only' as an option that
+     inhibits linking, just like `-c' or `-S', and to recognize and
+     properly handle the `-nostdlib', `-M', `-MM', `-nodefaultlibs',
+     and `-Xlinker' options.
+
+   * Upgrade to `libf2c' as of 1997-08-06.
+
+   * Modify `libf2c' to consistently and clearly diagnose recursive I/O
+     (at run time).
+
+   * `g77' driver now prints version information (such as produced by
+     `g77 -v') to `stderr' instead of `stdout'.
+
+   * The `.r' suffix now designates a Ratfor source file, to be
+     preprocessed via the `ratfor' command, available separately.
+
+   * Fix some aspects of how `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.
+
+   * Improve diagnostics.
+
+   * Improve documentation and indexing.
+
+   * Include all pertinent files for `libf2c' that come from
+     `netlib.bell-labs.com'; give any such files that aren't quite
+     accurate in `g77''s version of `libf2c' the suffix `.netlib'.
+
+   * Reserve `INTEGER(KIND=0)' for future use.
+
+In 0.5.20:
+==========
+
+   * The `-fno-typeless-boz' option is now the default.
+
+     This option specifies that non-decimal-radix constants using the
+     prefixed-radix form (such as `Z'1234'') are to be interpreted as
+     `INTEGER' constants.  Specify `-ftypeless-boz' to cause such
+     constants to be interpreted as typeless.
+
+     (Version 0.5.19 introduced `-fno-typeless-boz' and its inverse.)
+
+   * Options `-ff90-intrinsics-enable' and `-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 `libU77'
+     intrinsics.  Users of such programs might need to compile them
+     differently (using, for example, `-ff90-intrinsics-disable') or,
+     better yet, insert appropriate `EXTERNAL' statements specifying
+     that these names are not intended to be names of intrinsics.
+
+   * The `ALWAYS_FLUSH' macro is no longer defined when building
+     `libf2c', which should result in improved I/O performance,
+     especially over NFS.
+
+     *Note:* If you have code that depends on the behavior of `libf2c'
+     when built with `ALWAYS_FLUSH' defined, you will have to modify
+     `libf2c' accordingly before building it from this and future
+     versions of `g77'.
+
+   * Dave Love's implementation of `libU77' has been added to the
+     version of `libf2c' distributed with and built as part of `g77'.
+     `g77' now knows about the routines in this library as intrinsics.
+
+   * New option `-fvxt' specifies that the source file is written in
+     VXT Fortran, instead of GNU Fortran.
+
+   * The `-fvxt-not-f90' option has been deleted, along with its
+     inverse, `-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 `g77'.
+
+   * The `-fugly' option now issues a warning, as it likely will be
+     removed in a future version.
+
+     (Enabling all the `-fugly-*' options is unlikely to be feasible,
+     or sensible, in the future, so users should learn to specify only
+     those `-fugly-*' options they really need for a particular source
+     file.)
+
+   * The `-fugly-assumed' option, introduced in version 0.5.19, has
+     been changed to better accommodate old and new code.
+
+   * Make a number of fixes to the `g77' front end and the `gcc' back
+     end to better support Alpha (AXP) machines.  This includes
+     providing at least one bug-fix to the `gcc' back end for Alphas.
+
+   * Related to supporting Alpha (AXP) machines, the `LOC()' intrinsic
+     and `%LOC()' construct now return values of integer type that is
+     the same width (holds the same number of bits) as the pointer type
+     on the machine.
+
+     On most machines, this won't make a difference, whereas on Alphas,
+     the type these constructs return is `INTEGER*8' instead of the
+     more common `INTEGER*4'.
+
+   * Emulate `COMPLEX' arithmetic in the `g77' front end, to avoid bugs
+     in `complex' support in the `gcc' back end.  New option
+     `-fno-emulate-complex' causes `g77' to revert the 0.5.19 behavior.
+
+   * Fix bug whereby `REAL A(1)', for example, caused a compiler crash
+     if `-fugly-assumed' was in effect and A was a local (automatic)
+     array.  That case is no longer affected by the new handling of
+     `-fugly-assumed'.
+
+   * Fix `g77' command driver so that `g77 -o foo.f' no longer deletes
+     `foo.f' before issuing other diagnostics, and so the `-x' option
+     is properly handled.
+
+   * Enable inlining of subroutines and functions by the `gcc' back end.
+     This works as it does for `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.
+
+   * Dummy arguments are no longer assumed to potentially alias
+     (overlap) other dummy arguments or `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 `-fforce-addr' also is specified.
+
+     New options `-falias-check', `-fargument-alias',
+     `-fargument-noalias', and `-fno-argument-noalias-global' control
+     the way `g77' handles potential aliasing.
+
+   * The `CONJG()' and `DCONJG()' intrinsics now are compiled in-line.
+
+   * The bug-fix for 0.5.19.1 has been re-done.  The `g77' compiler has
+     been changed back to assume `libf2c' has no aliasing problems in
+     its implementations of the `COMPLEX' (and `DOUBLE COMPLEX')
+     intrinsics.  The `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.
+
+     *Note:* This change requires version 0.5.20 of `libf2c', at least,
+     when linking code produced by any versions of `g77' other than
+     0.5.19.1.  Use `g77 -v' to determine the version numbers of the
+     `libF77', `libI77', and `libU77' components of the `libf2c'
+     library.  (If these version numbers are not printed--in
+     particular, if the linker complains about unresolved references to
+     names like `g77__fvers__'--that strongly suggests your
+     installation has an obsolete version of `libf2c'.)
+
+   * New option `-fugly-assign' specifies that the same memory
+     locations are to be used to hold the values assigned by both
+     statements `I = 3' and `ASSIGN 10 TO I', for example.  (Normally,
+     `g77' uses a separate memory location to hold assigned statement
+     labels.)
+
+   * `FORMAT' and `ENTRY' statements now are allowed to precede
+     `IMPLICIT NONE' statements.
+
+   * Produce diagnostic for unsupported `SELECT CASE' on `CHARACTER'
+     type, instead of crashing, at compile time.
+
+   * Fix crashes involving diagnosed or invalid code.
+
+   * Change approach to building `libf2c' archive (`libf2c.a') so that
+     members are added to it only when truly necessary, so the user
+     that installs an already-built `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).
+
+   * Support `gcc' version 2.7.2.2 (modified by `g77' into version
+     2.7.2.2.f.2), and remove support for prior versions of `gcc'.
+
+   * Upgrade to `libf2c' as of 1997-02-08, and fix up some of the build
+     procedures.
+
+   * Improve general build procedures for `g77', fixing minor bugs
+     (such as deletion of any file named `f771' in the parent directory
+     of `gcc/').
+
+   * Enable full support of `INTEGER*8' available in `libf2c' and
+     `f2c.h' so that `f2c' users may make full use of its features via
+     the `g77' version of `f2c.h' and the `INTEGER*8' support routines
+     in the `g77' version of `libf2c'.
+
+   * Improve `g77' driver and `libf2c' so that `g77 -v' yields version
+     information on the library.
+
+   * The `SNGL' and `FLOAT' intrinsics now are specific intrinsics,
+     instead of synonyms for the generic intrinsic `REAL'.
+
+   * New intrinsics have been added.  These are `REALPART', `IMAGPART',
+     `COMPLEX', `LONG', and `SHORT'.
+
+   * A new group of intrinsics, `gnu', has been added to contain the
+     new `REALPART', `IMAGPART', and `COMPLEX' intrinsics.  An old
+     group, `dcp', has been removed.
+
+   * Complain about industry-wide ambiguous references `REAL(EXPR)' and
+     `AIMAG(EXPR)', where EXPR is `DOUBLE COMPLEX' (or any complex type
+     other than `COMPLEX'), unless `-ff90' option specifies Fortran 90
+     interpretation or new `-fugly-complex' option, in conjunction with
+     `-fnot-f90', specifies `f2c' interpretation.
+
+   * Make improvements to diagnostics.
+
+   * Speed up compiler a bit.
+
+   * 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 `M' for the node `Diagnostics' in the
+     top-level menu of the Info documentation.)
+
+In 0.5.19.1:
+============
+
+   * 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: `CONJG()', `DCONJG()',
+     `CCOS()', `CDCOS()', `CLOG()', `CDLOG()', `CSIN()', `CDSIN()',
+     `CSQRT()', `CDSQRT()', complex division, and raising a `DOUBLE
+     COMPLEX' operand to an `INTEGER' power.  (The related generic and
+     `Z'-prefixed intrinsics, such as `ZSIN()', also were affected.)
+
+     For example, `C = CSQRT(C)', `Z = Z/C', and `Z = Z**I' (where `C'
+     is `COMPLEX' and `Z' is `DOUBLE COMPLEX') have been fixed.
+
+In 0.5.19:
+==========
+
+   * Fix `FORMAT' statement parsing so negative values for specifiers
+     such as `P' (e.g. `FORMAT(-1PF8.1)') are correctly processed as
+     negative.
+
+   * Fix `SIGNAL' intrinsic so it once again accepts a procedure as its
+     second argument.
+
+   * A temporary kludge option provides bare-bones information on
+     `COMMON' and `EQUIVALENCE' members at debug time.
+
+   * New `-fonetrip' option specifies FORTRAN-66-style one-trip `DO'
+     loops.
+
+   * New `-fno-silent' option causes names of program units to be
+     printed as they are compiled, in a fashion similar to UNIX `f77'
+     and `f2c'.
+
+   * New `-fugly-assumed' option specifies that arrays dimensioned via
+     `DIMENSION X(1)', for example, are to be treated as assumed-size.
+
+   * New `-fno-typeless-boz' option specifies that non-decimal-radix
+     constants using the prefixed-radix form (such as `Z'1234'') are to
+     be interpreted as `INTEGER' constants.
+
+   * New `-ff66' option is a "shorthand" option that specifies
+     behaviors considered appropriate for FORTRAN 66 programs.
+
+   * New `-ff77' option is a "shorthand" option that specifies
+     behaviors considered appropriate for UNIX `f77' programs.
+
+   * New `-fugly-comma' and `-fugly-logint' options provided to perform
+     some of what `-fugly' used to do.  `-fugly' and `-fno-ugly' are
+     now "shorthand" options, in that they do nothing more than enable
+     (or disable) other `-fugly-*' options.
+
+   * Fix parsing of assignment statements involving targets that are
+     substrings of elements of `CHARACTER' arrays having names such as
+     `READ', `WRITE', `GOTO', and `REALFUNCTIONFOO'.
+
+   * Fix crashes involving diagnosed code.
+
+   * Fix handling of local `EQUIVALENCE' areas so certain cases of
+     valid Fortran programs are not misdiagnosed as improperly
+     extending the area backwards.
+
+   * Support `gcc' version 2.7.2.1.
+
+   * Upgrade to `libf2c' as of 1996-09-26, and fix up some of the build
+     procedures.
+
+   * Change code generation for list-directed I/O so it allows for new
+     versions of `libf2c' that might return non-zero status codes for
+     some operations previously assumed to always return zero.
+
+     This change not only affects how `IOSTAT=' variables are set by
+     list-directed I/O, it also affects whether `END=' and `ERR='
+     labels are reached by these operations.
+
+   * Add intrinsic support for new `FTELL' and `FSEEK' procedures in
+     `libf2c'.
+
+   * Modify `fseek_()' in `libf2c' to be more portable (though, in
+     practice, there might be no systems where this matters) and to
+     catch invalid `whence' arguments.
+
+   * Some useless warnings from the `-Wunused' option have been
+     eliminated.
+
+   * Fix a problem building the `f771' executable on AIX systems by
+     linking with the `-bbigtoc' option.
+
+   * Abort configuration if `gcc' has not been patched using the patch
+     file provided in the `gcc/f/gbe/' subdirectory.
+
+   * Add options `--help' and `--version' to the `g77' command, to
+     conform to GNU coding guidelines.  Also add printing of `g77'
+     version number when the `--verbose' (`-v') option is used.
+
+   * Change internally generated name for local `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.
+
+   * Improvements to documentation and indexing.
+
+In 0.5.18:
+==========
+
+   * Add some rudimentary support for `INTEGER*1', `INTEGER*2',
+     `INTEGER*8', and their `LOGICAL' equivalents.  (This support works
+     on most, maybe all, `gcc' targets.)
+
+     Thanks to Scott Snyder (<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.
+
+   * Add some rudimentary support for the `BYTE' and `WORD'
+     type-declaration statements.  `BYTE' corresponds to `INTEGER*1',
+     while `WORD' corresponds to `INTEGER*2'.
+
+     Thanks to Scott Snyder (<snyder@d0sgif.fnal.gov>) for providing
+     the patch for this!
+
+   * 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 `INTEGER*8', for example.
+
+   * Support automatic arrays in procedures.
+
+   * Reduce space/time requirements for handling large *sparsely*
+     initialized aggregate arrays.  This improvement applies to only a
+     subset of the general problem to be addressed in 0.6.
+
+   * 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, `-fzeros', is introduced to enable the traditional
+     treatment of zeros as any other value.
+
+   * With `-ff90' in force, `g77' incorrectly interpreted `REAL(Z)' as
+     returning a `REAL' result, instead of as a `DOUBLE PRECISION'
+     result.  (Here, `Z' is `DOUBLE COMPLEX'.)
+
+     With `-fno-f90' in force, the interpretation remains unchanged,
+     since this appears to be how at least some F77 code using the
+     `DOUBLE COMPLEX' extension expected it to work.
+
+     Essentially, `REAL(Z)' in F90 is the same as `DBLE(Z)', while in
+     extended F77, it appears to be the same as `REAL(REAL(Z))'.
+
+   * An expression involving exponentiation, where both operands were
+     type `INTEGER' and the right-hand operand was negative, was
+     erroneously evaluated.
+
+   * Fix bugs involving `DATA' implied-`DO' constructs (these involved
+     an errant diagnostic and a crash, both on good code, one involving
+     subsequent statement-function definition).
+
+   * Close `INCLUDE' files after processing them, so compiling source
+     files with lots of `INCLUDE' statements does not result in being
+     unable to open `INCLUDE' files after all the available file
+     descriptors are used up.
+
+   * Speed up compiling, especially of larger programs, and perhaps
+     slightly reduce memory utilization while compiling (this is *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.
+
+   * Introduce three new options that implement optimizations in the
+     `gcc' back end (GBE).  These options are `-fmove-all-movables',
+     `-freduce-all-givs', and `-frerun-loop-opt', which are enabled, by
+     default, for Fortran compilations.  These optimizations are
+     intended to help toon Fortran programs.
+
+   * Patch the GBE to do a better job optimizing certain kinds of
+     references to array elements.
+
+   * Due to patches to the GBE, the version number of `gcc' also is
+     patched to make it easier to manage installations, especially
+     useful if it turns out a `g77' change to the GBE has a bug.
+
+     The `g77'-modified version number is the `gcc' version number with
+     the string `.f.N' appended, where `f' identifies the version as
+     enhanced for Fortran, and N is `1' for the first Fortran patch for
+     that version of `gcc', `2' for the second, and so on.
+
+     So, this introduces version 2.7.2.f.1 of `gcc'.
+
+   * Make several improvements and fixes to diagnostics, including the
+     removal of two that were inappropriate or inadequate.
+
+   * Warning about two successive arithmetic operators, produced by
+     `-Wsurprising', now produced *only* when both operators are,
+     indeed, arithmetic (not relational/boolean).
+
+   * `-Wsurprising' now warns about the remaining cases of using
+     non-integral variables for implied-`DO' loops, instead of these
+     being rejected unless `-fpedantic' or `-fugly' specified.
+
+   * Allow `SAVE' of a local variable or array, even after it has been
+     given an initial value via `DATA', for example.
+
+   * Introduce an Info version of `g77' documentation, which supercedes
+     `gcc/f/CREDITS', `gcc/f/DOC', and `gcc/f/PROJECTS'.  These files
+     will be removed in a future release.  The files `gcc/f/BUGS',
+     `gcc/f/INSTALL', and `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
+     `g77-0.5.16/f/DOC' that was contributed to Craig by David Ronis
+     (<ronis@onsager.chem.mcgill.ca>).
+
+   * New `-fno-second-underscore' option to specify that, when
+     `-funderscoring' is in effect, a second underscore is not to be
+     appended to Fortran names already containing an underscore.
+
+   * Change the way iterative `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 `DO' variable, but the result of the
+     calculation is always converted to the default `INTEGER' type.
+
+     (This should have no effect on existing code compiled by `g77',
+     but code written to assume that use of a *wider* type for the `DO'
+     variable will result in an iteration count being fully calculated
+     using that wider type (wider than default `INTEGER') must be
+     rewritten.)
+
+   * Support `gcc' version 2.7.2.
+
+   * Upgrade to `libf2c' as of 1996-03-23, and fix up some of the build
+     procedures.
+
+     Note that the email addresses related to `f2c' have changed--the
+     distribution site now is named `netlib.bell-labs.com', and the
+     maintainer's new address is <dmg@bell-labs.com>.
+
+In 0.5.17:
+==========
+
+   * *Fix serious bug* in `g77 -v' command that can cause removal of a
+     system's `/dev/null' special file if run by user `root'.
+
+     *All users* of version 0.5.16 should ensure that they have not
+     removed `/dev/null' or replaced it with an ordinary file (e.g. by
+     comparing the output of `ls -l /dev/null' with `ls -l /dev/zero'.
+     If the output isn't basically the same, contact your system
+     administrator about restoring `/dev/null' to its proper status).
+
+     This bug is particularly insidious because removing `/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 `g77 -v' runs the `ld' command with `-o /dev/null'
+     that `ld' tries to *remove* the executable it is supposed to build
+     (especially if it reports unresolved references, which it should
+     in this case)!
+
+   * Fix crash on `CHARACTER*(*) FOO' in a main or block data program
+     unit.
+
+   * Fix crash that can occur when diagnostics given outside of any
+     program unit (such as when input file contains `@foo').
+
+   * Fix crashes, infinite loops (hangs), and such involving diagnosed
+     code.
+
+   * Fix `ASSIGN''ed variables so they can be `SAVE''d or dummy
+     arguments, and issue clearer error message in cases where target
+     of `ASSIGN' or `ASSIGN'ed `GOTO'/`FORMAT' is too small (which
+     should never happen).
+
+   * Make `libf2c' build procedures work on more systems again by
+     eliminating unnecessary invocations of `ld -r -x' and `mv'.
+
+   * Fix omission of `-funix-intrinsics-...' options in list of
+     permitted options to compiler.
+
+   * Fix failure to always diagnose missing type declaration for
+     `IMPLICIT NONE'.
+
+   * 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 `INTEGER' constant for
+     the right-hand operator (e.g. `I**32767').
+
+   * Fix build procedures so cross-compiling `g77' (the `fini' utility
+     in particular) is properly built using the host compiler.
+
+   * Add new `-Wsurprising' option to warn about constructs that are
+     interpreted by the Fortran standard (and `g77') in ways that are
+     surprising to many programmers.
+
+   * Add `ERF()' and `ERFC()' as generic intrinsics mapping to existing
+     `ERF'/`DERF' and `ERFC'/`DERFC' specific intrinsics.
+
+     *Note:* You should specify `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. `f2c').
+
+   * Remove from `-fno-pedantic' the diagnostic about `DO' with
+     non-`INTEGER' index variable; issue that under `-Wsurprising'
+     instead.
+
+   * Clarify some diagnostics that say things like "ignored" when that's
+     misleading.
+
+   * Clarify diagnostic on use of `.EQ.'/`.NE.' on `LOGICAL' operands.
+
+   * Minor improvements to code generation for various operations on
+     `LOGICAL' operands.
+
+   * Minor improvement to code generation for some `DO' loops on some
+     machines.
+
+   * Support `gcc' version 2.7.1.
+
+   * Upgrade to `libf2c' as of 1995-11-15.
+
+In 0.5.16:
+==========
+
+   * Fix a code-generation bug involving complicated `EQUIVALENCE'
+     statements not involving `COMMON'.
+
+   * Fix code-generation bugs involving invoking "gratis" library
+     procedures in `libf2c' from code compiled with `-fno-f2c' by
+     making these procedures known to `g77' as intrinsics (not affected
+     by -fno-f2c).  This is known to fix code invoking `ERF()',
+     `ERFC()', `DERF()', and `DERFC()'.
+
+   * Update `libf2c' to include netlib patches through 1995-08-16, and
+     `#define' `WANT_LEAD_0' to 1 to make `g77'-compiled code more
+     consistent with other Fortran implementations by outputting
+     leading zeros in formatted and list-directed output.
+
+   * 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 `f2c' plus `gcc' (but
+     apparently only when using `gcc-2.7.0' or later).
+
+   * Fix a code-generation bug involving invocation of `COMPLEX' and
+     `DOUBLE COMPLEX' `FUNCTION's and doing `COMPLEX' and `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.
+
+   * Fix crash by not generating new optimal code for `X**I' if `I' is
+     nonconstant and the expression is used to dimension a dummy array,
+     since the `gcc' back end does not support the necessary mechanics
+     (and the `gcc' front end rejects the equivalent construct, as it
+     turns out).
+
+   * Fix crash on expressions like `COMPLEX**INTEGER'.
+
+   * Fix crash on expressions like `(1D0,2D0)**2', i.e. raising a
+     `DOUBLE COMPLEX' constant to an `INTEGER' constant power.
+
+   * Fix crashes and such involving diagnosed code.
+
+   * Diagnose, instead of crashing on, statement function definitions
+     having duplicate dummy argument names.
+
+   * Fix bug causing rejection of good code involving statement function
+     definitions.
+
+   * Fix bug resulting in debugger not knowing size of local equivalence
+     area when any member of area has initial value (via `DATA', for
+     example).
+
+   * Fix installation bug that prevented installation of `g77' driver.
+     Provide for easy selection of whether to install copy of `g77' as
+     `f77' to replace the broken code.
+
+   * Fix `gcc' driver (affects `g77' thereby) to not gratuitously
+     invoke the `f771' program (e.g. when `-E' is specified).
+
+   * Fix diagnostic to point to correct source line when it immediately
+     follows an `INCLUDE' statement.
+
+   * Support more compiler options in `gcc'/`g77' when compiling
+     Fortran files.  These options include `-p', `-pg', `-aux-info',
+     `-P', correct setting of version-number macros for preprocessing,
+     full recognition of `-O0', and automatic insertion of
+     configuration-specific linker specs.
+
+   * Add new intrinsics that interface to existing routines in `libf2c':
+     `ABORT', `DERF', `DERFC', `ERF', `ERFC', `EXIT', `FLUSH',
+     `GETARG', `GETENV', `IARGC', `SIGNAL', and `SYSTEM'.  Note that
+     `ABORT', `EXIT', `FLUSH', `SIGNAL', and `SYSTEM' are intrinsic
+     subroutines, not functions (since they have side effects), so to
+     get the return values from `SIGNAL' and `SYSTEM', append a final
+     argument specifying an `INTEGER' variable or array element (e.g.
+     `CALL SYSTEM('rm foo',ISTAT)').
+
+   * Add new intrinsic group named `unix' to contain the new intrinsics,
+     and by default enable this new group.
+
+   * Move `LOC()' intrinsic out of the `vxt' group to the new `unix'
+     group.
+
+   * Improve `g77' so that `g77 -v' by itself (or with certain other
+     options, including `-B', `-b', `-i', `-nostdlib', and `-V')
+     reports lots more useful version info, and so that long-form
+     options `gcc' accepts are understood by `g77' as well (even in
+     truncated, unambiguous forms).
+
+   * Add new `g77' option `--driver=name' to specify driver when
+     default, `gcc', isn't appropriate.
+
+   * Add support for `#' directives (as output by the preprocessor) in
+     the compiler, and enable generation of those directives by the
+     preprocessor (when compiling `.F' files) so diagnostics and
+     debugging info are more useful to users of the preprocessor.
+
+   * Produce better diagnostics, more like `gcc', with info such as `In
+     function `foo':' and `In file included from...:'.
+
+   * Support `gcc''s `-fident' and `-fno-ident' options.
+
+   * When `-Wunused' in effect, don't warn about local variables used as
+     statement-function dummy arguments or `DATA' implied-`DO' iteration
+     variables, even though, strictly speaking, these are not uses of
+     the variables themselves.
+
+   * When `-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 (`g77' might someday start warning about
+     these)--applies to `gcc' versions 2.7.0 and later, since earlier
+     versions didn't warn about unused dummy arguments.
+
+   * New option `-fno-underscoring' that inhibits transformation of
+     names (by appending one or two underscores) so users may experiment
+     with implications of such an environment.
+
+   * Minor improvement to `gcc/f/info' module to make it easier to build
+     `g77' using the native (non-`gcc') compiler on certain machines
+     (but definitely not all machines nor all non-`gcc' compilers).
+     Please do not report bugs showing problems compilers have with
+     macros defined in `gcc/f/target.h' and used in places like
+     `gcc/f/expr.c'.
+
+   * Add warning to be printed for each invocation of the compiler if
+     the target machine `INTEGER', `REAL', or `LOGICAL' size is not 32
+     bits, since `g77' is known to not work well for such cases (to be
+     fixed in Version 0.6--*note Actual Bugs We Haven't Fixed Yet:
+     Actual Bugs.).
+
+   * Lots of new documentation (though work is still needed to put it
+     into canonical GNU format).
+
+   * Build `libf2c' with `-g0', not `-g2', in effect (by default), to
+     produce smaller library without lots of debugging clutter.
+
+In 0.5.15:
+==========
+
+   * Fix bad code generation involving `X**I' and temporary, internal
+     variables generated by `g77' and the back end (such as for `DO'
+     loops).
+
+   * Fix crash given `CHARACTER A;DATA A/.TRUE./'.
+
+   * Replace crash with diagnostic given `CHARACTER A;DATA A/1.0/'.
+
+   * Fix crash or other erratic behavior when null character constant
+     (`''') is encountered.
+
+   * Fix crash or other erratic behavior involving diagnosed code.
+
+   * Fix code generation for external functions returning type `REAL'
+     when the `-ff2c' option is in force (which it is by default) so
+     that `f2c' compatibility is indeed provided.
+
+   * Disallow `COMMON I(10)' if `I' has previously been specified with
+     an array declarator.
+
+   * New `-ffixed-line-length-N' option, where N is the maximum length
+     of a typical fixed-form line, defaulting to 72 columns, such that
+     characters beyond column N are ignored, or N is `none', meaning no
+     characters are ignored.  does not affect lines with `&' in column
+     1, which are always processed as if `-ffixed-line-length-none' was
+     in effect.
+
+   * No longer generate better code for some kinds of array references,
+     as `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.
+
+   * In `COMMON' and `EQUIVALENCE' areas with any members given initial
+     values (e.g. via `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 `g77').
+     Previously, in some `COMMON'/`EQUIVALENCE' areas (essentially
+     those with members of more than one type), the uninitialized
+     members were initialized to spaces, to cater to `CHARACTER' types,
+     but it seems no existing code expects that, while much existing
+     code expects binary zeros.
+
+In 0.5.14:
+==========
+
+   * Don't emit bad code when low bound of adjustable array is
+     nonconstant and thus might vary as an expression at run time.
+
+   * Emit correct code for calculation of number of trips in `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.)
+
+   * Fix crash when extra parentheses surround item in `DATA'
+     implied-`DO' list.
+
+   * Fix crash over minor internal inconsistencies in handling
+     diagnostics, just substitute dummy strings where necessary.
+
+   * Fix crash on some systems when compiling call to `MVBITS()'
+     intrinsic.
+
+   * Fix crash on array assignment `TYPEDDD(...)=...', where DDD is a
+     string of one or more digits.
+
+   * Fix crash on `DCMPLX()' with a single `INTEGER' argument.
+
+   * Fix various crashes involving code with diagnosed errors.
+
+   * Support `-I' option for `INCLUDE' statement, plus `gcc''s
+     `header.gcc' facility for handling systems like MS-DOS.
+
+   * Allow `INCLUDE' statement to be continued across multiple lines,
+     even allow it to coexist with other statements on the same line.
+
+   * Incorporate Bellcore fixes to `libf2c' through 1995-03-15--this
+     fixes a bug involving infinite loops reading EOF with empty
+     list-directed I/O list.
+
+   * Remove all the `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 `g77', which expects
+     a working ANSI C environment (and, for now, a GNU C compiler to
+     compile `g77' itself).
+
+   * Complain if initialized common redeclared as larger in subsequent
+     program unit.
+
+   * Warn if blank common initialized, since its size can vary and hence
+     related warnings that might be helpful won't be seen.
+
+   * New `-fbackslash' option, on by default, that causes `\' within
+     `CHARACTER' and Hollerith constants to be interpreted a la GNU C.
+     Note that this behavior is somewhat different from `f2c''s, which
+     supports only a limited subset of backslash (escape) sequences.
+
+   * Make `-fugly-args' the default.
+
+   * New `-fugly-init' option, on by default, that allows
+     typeless/Hollerith to be specified as initial values for variables
+     or named constants (`PARAMETER'), and also allows
+     character<->numeric conversion in those contexts--turn off via
+     `-fno-ugly-init'.
+
+   * New `-finit-local-zero' option to initialize local variables to
+     binary zeros.  This does not affect whether they are `SAVE'd, i.e.
+     made automatic or static.
+
+   * New `-Wimplicit' option to warn about implicitly typed variables,
+     arrays, and functions.  (Basically causes all program units to
+     default to `IMPLICIT NONE'.)
+
+   * `-Wall' now implies `-Wuninitialized' as with `gcc' (i.e. unless
+     `-O' not specified, since `-Wuninitialized' requires `-O'), and
+     implies `-Wunused' as well.
+
+   * `-Wunused' no longer gives spurious messages for unused `EXTERNAL'
+     names (since they are assumed to refer to block data program
+     units, to make use of libraries more reliable).
+
+   * Support `%LOC()' and `LOC()' of character arguments.
+
+   * Support null (zero-length) character constants and expressions.
+
+   * Support `f2c''s `IMAG()' generic intrinsic.
+
+   * Support `ICHAR()', `IACHAR()', and `LEN()' of character
+     expressions that are valid in assignments but not normally as
+     actual arguments.
+
+   * Support `f2c'-style `&' in column 1 to mean continuation line.
+
+   * Allow `NAMELIST', `EXTERNAL', `INTRINSIC', and `VOLATILE' in
+     `BLOCK DATA', even though these are not allowed by the standard.
+
+   * Allow `RETURN' in main program unit.
+
+   * Changes to Hollerith-constant support to obey Appendix C of the
+     standard:
+
+        - Now padded on the right with zeros, not spaces.
+
+        - Hollerith "format specifications" in the form of arrays of
+          non-character allowed.
+
+        - Warnings issued when non-space truncation occurs when
+          converting to another type.
+
+        - When specified as actual argument, now passed by reference to
+          `INTEGER' (padded on right with spaces if constant too small,
+          otherwise fully intact if constant wider the `INTEGER' type)
+          instead of by value.
+
+     *Warning:* `f2c' differs on the interpretation of `CALL FOO(1HX)',
+     which it treats exactly the same as `CALL FOO('X')', but which the
+     standard and `g77' treat as `CALL FOO(%REF('X   '))' (padded with
+     as many spaces as necessary to widen to `INTEGER'), essentially.
+
+   * Changes and fixes to typeless-constant support:
+
+        - Now treated as a typeless double-length `INTEGER' value.
+
+        - Warnings issued when overflow occurs.
+
+        - Padded on the left with zeros when converting to a larger
+          type.
+
+        - Should be properly aligned and ordered on the target machine
+          for whatever type it is turned into.
+
+        - When specified as actual argument, now passed as reference to
+          a default `INTEGER' constant.
+
+   * `%DESCR()' of a non-`CHARACTER' expression now passes a pointer to
+     the expression plus a length for the expression just as if it were
+     a `CHARACTER' expression.  For example, `CALL FOO(%DESCR(D))',
+     where `D' is `REAL*8', is the same as `CALL FOO(D,%VAL(8)))'.
+
+   * 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 `SUBROUTINE X' with alternate
+     entry points is now `__g77_masterfun_x'.
+
+   * Remove redundant message about zero-step-count `DO' loops.
+
+   * Clean up diagnostic messages, shortening many of them.
+
+   * Fix typo in `g77' man page.
+
+   * Clarify implications of constant-handling bugs in `f/BUGS'.
+
+   * Generate better code for `**' operator with a right-hand operand of
+     type `INTEGER'.
+
+   * Generate better code for `SQRT()' and `DSQRT()', also when
+     `-ffast-math' specified, enable better code generation for `SIN()'
+     and `COS()'.
+
+   * Generate better code for some kinds of array references.
+
+   * Speed up lexing somewhat (this makes the compilation phase
+     noticeably faster).
+
diff --git a/gcc/f/README b/gcc/f/README
new file mode 100644
index 00000000000..fdebfdca176
--- /dev/null
+++ b/gcc/f/README
@@ -0,0 +1,7 @@
+1995-02-15
+
+This directory is the f/ subdirectory, which is designed to
+be a subdirectory in a gcc development tree, i.e. named gcc/f/.
+
+Please see gcc/README.g77 for information on the contents of this
+directory.
diff --git a/gcc/f/assert.j b/gcc/f/assert.j
new file mode 100644
index 00000000000..fe95676ea53
--- /dev/null
+++ b/gcc/f/assert.j
@@ -0,0 +1,27 @@
+/* assert.j -- Wrapper for GCC's assert.h
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 MAKING_DEPENDENCIES
+#ifndef _J_f_assert
+#define _J_f_assert
+#include "assert.h"
+#endif
+#endif
diff --git a/gcc/f/bad.c b/gcc/f/bad.c
new file mode 100644
index 00000000000..3db782f9259
--- /dev/null
+++ b/gcc/f/bad.c
@@ -0,0 +1,543 @@
+/* bad.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 <ctype.h>
+#include "bad.h"
+#include "com.h"
+#include "where.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_
+  {
+    ffebadSeverity severity;
+    char *message;
+  };
+
+/* Static objects accessed by functions in this module.	 */
+
+static struct _ffebad_message_ ffebad_messages_[]
+=
+{
+#define FFEBAD_MSGS1(KWD,SEV,MSG) { SEV, MSG },
+#if FFEBAD_LONG_MSGS_ == 0
+#define FFEBAD_MSGS2(KWD,SEV,LMSG,SMSG) { SEV, SMSG },
+#else
+#define FFEBAD_MSGS2(KWD,SEV,LMSG,SMSG) { SEV, LMSG },
+#endif
+#include "bad.def"
+#undef FFEBAD_MSGS1
+#undef FFEBAD_MSGS2
+};
+
+static struct
+  {
+    ffewhereLine line;
+    ffewhereColumn col;
+    ffebadIndex tag;
+  }
+
+ffebad_here_[FFEBAD_MAX_];
+static char *ffebad_string_[FFEBAD_MAX_];
+static ffebadIndex ffebad_order_[FFEBAD_MAX_];
+static ffebad ffebad_errnum_;
+static ffebadSeverity ffebad_severity_;
+static 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, 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, 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 ()
+{
+  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,
+	       char *message)
+{
+  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_ = ffebad_messages_[errnum].message;
+    }
+  else
+    {
+      ffebad_severity_ = sev;
+      ffebad_message_ = message;
+    }
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    extern int inhibit_warnings;	/* From toplev.c. */
+
+    switch (ffebad_severity_)
+      {				/* Tell toplev.c about this message. */
+      case FFEBAD_severityINFORMATIONAL:
+      case FFEBAD_severityTRIVIAL:
+	if (inhibit_warnings)
+	  {			/* User wants no warnings. */
+	    ffebad_is_temp_inhibited_ = TRUE;
+	    return FALSE;
+	  }
+	/* Fall through.  */
+      case FFEBAD_severityWARNING:
+      case FFEBAD_severityPECULIAR:
+      case FFEBAD_severityPEDANTIC:
+	if ((ffebad_severity_ != FFEBAD_severityPEDANTIC)
+	    || !flag_pedantic_errors)
+	  {
+	    if (count_error (1) == 0)
+	      {			/* User wants no warnings. */
+		ffebad_is_temp_inhibited_ = TRUE;
+		return FALSE;
+	      }
+	    break;
+	  }
+	/* Fall through (PEDANTIC && flag_pedantic_errors).  */
+      case FFEBAD_severityFATAL:
+      case FFEBAD_severityWEIRD:
+      case FFEBAD_severitySEVERE:
+      case FFEBAD_severityDISASTER:
+	count_error (0);
+	break;
+
+      default:
+	break;
+      }
+  }
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+  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(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 (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 ()
+{
+#define MAX_SPACES 132
+  static char *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;
+  char c;
+  char *s;
+  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);
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+	  report_error_function (fn);
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
+	  fprintf (stderr,
+#if 0
+		   "Line %" ffewhereLineNumber_f "u of %s:\n   %s\n   %s%c",
+		   rn, fn,
+#else
+		   /* the trailing space on the <file>:<line>: line
+		      fools emacs19 compilation mode into finding the
+		      report */
+		   "%s:%" ffewhereLineNumber_f "u: %s\n   %s\n   %s%c",
+		   fn, rn,
+#endif
+		   s,
+		   ffewhere_line_content (l),
+		   &spaces[cn > MAX_SPACES ? 0 : MAX_SPACES - cn + 4],
+		   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') && isalpha (s[0]) && islower (s[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 (isalpha (c) && 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
new file mode 100644
index 00000000000..507bfed55b0
--- /dev/null
+++ b/gcc/f/bad.def
@@ -0,0 +1,705 @@
+/* bad.def -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995-1997 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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_MSGS1 (FFEBAD_MISSING_FIRST_BINARY_OPERAND, FATAL,
+"Missing first operand for binary operator at %0")
+FFEBAD_MSGS1 (FFEBAD_NULL_CHAR_CONST, WARN,
+"Zero-length character constant at %0")
+FFEBAD_MSGS1 (FFEBAD_INVALID_TOKEN_IN_EXPRESSION, FATAL,
+"Invalid token at %0 in expression or subexpression at %1")
+FFEBAD_MSGS1 (FFEBAD_MISSING_OPERAND_FOR_OPERATOR, FATAL,
+"Missing operand for operator at %1 at end of expression at %0")
+FFEBAD_MSGS1 (FFEBAD_LABEL_ALREADY_DEFINED, FATAL,
+"Label %A already defined at %1 when redefined at %0")
+FFEBAD_MSGS1 (FFEBAD_UNRECOGNIZED_CHARACTER, FATAL,
+"Unrecognized character at %0 [info -f g77 M LEX]")
+FFEBAD_MSGS1 (FFEBAD_LABEL_WITHOUT_STMT, WARN,
+"Label definition %A at %0 on empty statement (as of %1)")
+FFEBAD_MSGS2 (FFEBAD_EXTRA_LABEL_DEF, FATAL,
+"Extra label definition %A at %0 -- perhaps previous label definition %B at %1 should have CONTINUE statement?",
+"Extra label definition %A at %0 following label definition %B at %1")
+FFEBAD_MSGS1 (FFEBAD_FIRST_CHAR_INVALID, FATAL,
+"Invalid first character at %0 [info -f g77 M LEX]")
+FFEBAD_MSGS1 (FFEBAD_LINE_TOO_LONG, FATAL,
+"Line too long as of %0 [info -f g77 M LEX]")
+FFEBAD_MSGS1 (FFEBAD_LABEL_FIELD_NOT_NUMERIC, FATAL,
+"Non-numeric character at %0 in label field [info -f g77 M LEX]")
+FFEBAD_MSGS1 (FFEBAD_LABEL_NUMBER_INVALID, FATAL,
+"Label number at %0 not in range 1-99999")
+FFEBAD_MSGS1 (FFEBAD_NON_ANSI_COMMENT, WARN,
+"At %0, '!' and '/*' are not valid comment delimiters")
+FFEBAD_MSGS1 (FFEBAD_NON_ANSI_CONTINUATION_COLUMN, WARN,
+"Continuation indicator at %0 must appear in column 6 [info -f g77 M LEX]")
+FFEBAD_MSGS1 (FFEBAD_LABEL_ON_CONTINUATION, FATAL,
+"Label at %0 invalid with continuation line indicator at %1 [info -f g77 M LEX]")
+FFEBAD_MSGS2 (FFEBAD_INVALID_CONTINUATION, FATAL,
+"Continuation indicator at %0 invalid on first non-comment line of file or following END or INCLUDE [info -f g77 M LEX]",
+"Continuation indicator at %0 invalid here [info -f g77 M LEX]")
+FFEBAD_MSGS1 (FFEBAD_NO_CLOSING_APOSTROPHE, FATAL,
+"Character constant at %0 has no closing apostrophe at %1")
+FFEBAD_MSGS1 (FFEBAD_NOT_ENOUGH_HOLLERITH_CHARS, FATAL,
+"Hollerith constant at %0 specified %A more characters than are present as of %1")
+FFEBAD_MSGS1 (FFEBAD_MISSING_CLOSE_PAREN, FATAL,
+"Missing close parenthese at %0 needed to match open parenthese at %1")
+FFEBAD_MSGS1 (FFEBAD_INTEGER_TOO_LARGE, FATAL,
+"Integer at %0 too large")
+FFEBAD_MSGS2 (FFEBAD_BAD_MAGICAL, WARN,
+"Integer at %0 too large except as negative number (preceded by unary minus sign)",
+"Non-negative integer at %0 too large")
+FFEBAD_MSGS2 (FFEBAD_BAD_MAGICAL_PRECEDENCE, WARN,
+"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",
+"Integer at %0 too large (%2 has precedence over %1)")
+FFEBAD_MSGS2 (FFEBAD_BAD_MAGICAL_BINARY, WARN,
+"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",
+"Integer at %0 too large (needs unary, not binary, minus at %1)")
+FFEBAD_MSGS2 (FFEBAD_BAD_MAGICAL_PRECEDENCE_BINARY, WARN,
+"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",
+"Integer at %0 too large (%2 has precedence over %1, which needs to be unary, not binary, minus)")
+FFEBAD_MSGS1 (FFEBAD_IGNORING_PERIOD, FATAL,
+"Period at %0 not followed by digits for floating-point number or by `NOT.', `TRUE.', or `FALSE.'")
+FFEBAD_MSGS1 (FFEBAD_INSERTING_PERIOD, FATAL,
+"Missing close-period between `.%A' at %0 and %1")
+FFEBAD_MSGS1 (FFEBAD_INVALID_EXPONENT, FATAL,
+"Invalid exponent at %0 for real constant at %1; nondigit `%A' in exponent field")
+FFEBAD_MSGS1 (FFEBAD_MISSING_EXPONENT_VALUE, FATAL,
+"Missing value at %1 for real-number exponent at %0")
+FFEBAD_MSGS1 (FFEBAD_MISSING_BINARY_OPERATOR, FATAL,
+"Expected binary operator between expressions at %0 and at %1")
+FFEBAD_MSGS2 (FFEBAD_INVALID_DOTDOT, FATAL,
+"Period at %0 not followed by valid keyword forming a valid binary operator; `.%A.' is not a valid binary operator",
+"`.%A.' at %0 not a binary operator")
+FFEBAD_MSGS2 (FFEBAD_QUOTE_MISSES_DIGITS, FATAL,
+"Double-quote at %0 not followed by a string of valid octal digits at %1",
+"Invalid octal constant at %0")
+FFEBAD_MSGS2 (FFEBAD_INVALID_BINARY_DIGIT, FATAL,
+"Invalid binary digit(s) found in string of digits at %0",
+"Invalid binary constant at %0")
+FFEBAD_MSGS2 (FFEBAD_INVALID_HEX_DIGIT, FATAL,
+"Invalid hexadecimal digit(s) found in string of digits at %0",
+"Invalid hexadecimal constant at %0")
+FFEBAD_MSGS2 (FFEBAD_INVALID_OCTAL_DIGIT, FATAL,
+"Invalid octal digit(s) found in string of digits at %0",
+"Invalid octal constant at %0")
+FFEBAD_MSGS2 (FFEBAD_INVALID_RADIX_SPECIFIER, FATAL,
+"Invalid radix specifier `%A' at %0 for typeless constant at %1",
+"Invalid typeless constant at %1")
+FFEBAD_MSGS2 (FFEBAD_INVALID_TYPELESS_BINARY_DIGIT, FATAL,
+"Invalid binary digit(s) found in string of digits at %0",
+"Invalid binary constant at %0")
+FFEBAD_MSGS2 (FFEBAD_INVALID_TYPELESS_OCTAL_DIGIT, FATAL,
+"Invalid octal digit(s) found in string of digits at %0",
+"Invalid octal constant at %0")
+FFEBAD_MSGS2 (FFEBAD_INVALID_TYPELESS_HEX_DIGIT, FATAL,
+"Invalid hexadecimal digit(s) found in string of digits at %0",
+"Invalid hexadecimal constant at %0")
+FFEBAD_MSGS2 (FFEBAD_INVALID_COMPLEX_PART, FATAL,
+"%A part of complex constant at %0 must be a real or integer constant -- otherwise use CMPLX() or COMPLEX() in place of ()",
+"%A part of complex constant at %0 not a real or integer constant")
+FFEBAD_MSGS2 (FFEBAD_INVALID_PERCENT, FATAL,
+"Invalid keyword `%%%A' at %0 in this context",
+"Invalid keyword `%%%A' at %0")
+FFEBAD_MSGS2 (FFEBAD_NULL_EXPRESSION, FATAL,
+"Null expression between %0 and %1 invalid in this context",
+"Invalid null expression between %0 and %1")
+FFEBAD_MSGS2 (FFEBAD_CONCAT_ARGS_TYPE, FATAL,
+"Concatenation operator at %0 must operate on two subexpressions of character type, but neither subexpression at %1 or %2 is of character type",
+"Invalid operands at %1 and %2 for concatenation operator at %0")
+FFEBAD_MSGS2 (FFEBAD_CONCAT_ARG_TYPE, FATAL,
+"Concatenation operator at %0 must operate on two subexpressions of character type, but the subexpression at %1 is not of character type",
+"Invalid operand at %1 for concatenation operator at %0")
+FFEBAD_MSGS2 (FFEBAD_CONCAT_ARG_KIND, FATAL,
+"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",
+"Invalid operand (is %A) at %1 for concatenation operator at %0")
+FFEBAD_MSGS2 (FFEBAD_MATH_ARGS_TYPE, FATAL,
+"Arithmetic operator at %0 must operate on two subexpressions of arithmetic type, but neither subexpression at %1 or %2 is of arithmetic type",
+"Invalid operands at %1 and %2 for arithmetic operator at %0")
+FFEBAD_MSGS2 (FFEBAD_MATH_ARG_TYPE, FATAL,
+"Arithmetic operator at %0 must operate on two subexpressions of arithmetic type, but the subexpression at %1 is not of arithmetic type",
+"Invalid operand at %1 for arithmetic operator at %0")
+FFEBAD_MSGS2 (FFEBAD_MATH_ARG_KIND, FATAL,
+"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",
+"Invalid operand (is %A) at %1 for arithmetic operator at %0")
+FFEBAD_MSGS2 (FFEBAD_NO_CLOSING_QUOTE, FATAL,
+"Character constant at %0 has no closing quote at %1 [info -f g77 M LEX]",
+"Unterminated character constant at %0 [info -f g77 M LEX]")
+FFEBAD_MSGS2 (FFEBAD_BAD_CHAR_CONTINUE, FATAL,
+"Continuation line at %0 must have initial `&' since it continues a character context [info -f g77 M LEX]",
+"Missing initial `&' on continuation line at %0 [info -f g77 M LEX]")
+FFEBAD_MSGS2 (FFEBAD_BAD_LEXTOK_CONTINUE, FATAL,
+"Continuation line at %0 must have initial `&' since it continues a split lexical token [info -f g77 M LEX]",
+"Missing initial `&' on continuation line at %0 [info -f g77 M LEX]")
+FFEBAD_MSGS2 (FFEBAD_BAD_FREE_CONTINUE, FATAL,
+"Continuation line at %0 invalid because it consists only of a single `&' as the only nonblank character",
+"Invalid continuation line at %0")
+FFEBAD_MSGS2 (FFEBAD_STMT_BEGINS_BAD, FATAL,
+"Statement at %0 begins with invalid token [info -f g77 M LEX]",
+"Invalid statement at %0 [info -f g77 M LEX]")
+FFEBAD_MSGS1 (FFEBAD_SEMICOLON, FATAL,
+"Semicolon at %0 is an invalid token")
+FFEBAD_MSGS2 (FFEBAD_UNREC_STMT, FATAL,
+"Unrecognized statement name at %0 and invalid form for assignment or statement-function definition at %1",
+"Invalid statement at %0")
+FFEBAD_MSGS2 (FFEBAD_INVALID_STMT_FORM, FATAL,
+"Invalid form for %A statement at %0",
+"Invalid %A statement at %0")
+FFEBAD_MSGS2 (FFEBAD_INVALID_HOLL_IN_STMT, FATAL,
+"Invalid use of hollerith constant in statement at %0 -- enclose the constant in parentheses (for example, change BACKSPACE 2HAB to BACKSPACE (2HAB))",
+"Enclose hollerith constant in statement at %0 in parentheses")
+FFEBAD_MSGS1 (FFEBAD_FORMAT_EXTRA_COMMA, FATAL,
+"Extraneous comma in FORMAT statement at %0")
+FFEBAD_MSGS1 (FFEBAD_FORMAT_MISSING_COMMA, WARN,
+"Missing comma in FORMAT statement at %0")
+FFEBAD_MSGS1 (FFEBAD_FORMAT_SPURIOUS_SIGN, FATAL,
+"Spurious sign in FORMAT statement at %0")
+FFEBAD_MSGS1 (FFEBAD_FORMAT_SPURIOUS_NUMBER, FATAL,
+"Spurious number in FORMAT statement at %0")
+FFEBAD_MSGS1 (FFEBAD_FORMAT_TEXT_IN_NUMBER, FATAL,
+"Spurious text trailing number in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_P_NOCOMMA, FATAL,
+"nP control edit descriptor not followed by comma but followed by edit descriptor at %0 other than D, E, EN, F, or G",
+"Invalid edit descriptor at %0 following nP control edit descriptor")
+FFEBAD_MSGS1 (FFEBAD_FORMAT_BAD_SPEC, FATAL,
+"Unrecognized FORMAT specifier at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_I_SPEC, FATAL,
+"Invalid I specifier in FORMAT statement at %0 -- correct form: [r]Iw.[m]",
+"Invalid I specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_B_SPEC, FATAL,
+"Invalid B specifier in FORMAT statement at %0 -- correct form: [r]Bw.[m]",
+"Invalid B specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_O_SPEC, FATAL,
+"Invalid O specifier in FORMAT statement at %0 -- correct form: [r]Ow.[m]",
+"Invalid O specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_Z_SPEC, FATAL,
+"Invalid Z specifier in FORMAT statement at %0 -- correct form: [r]Zw.[m]",
+"Invalid Z specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_F_SPEC, FATAL,
+"Invalid F specifier in FORMAT statement at %0 -- correct form: [r]Fw.d",
+"Invalid F specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_E_SPEC, FATAL,
+"Invalid E specifier in FORMAT statement at %0 -- correct form: [r]Ew.d[Ee]",
+"Invalid E specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_EN_SPEC, FATAL,
+"Invalid EN specifier in FORMAT statement at %0 -- correct form: [r]ENw.d[Ee]",
+"Invalid EN specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_G_SPEC, FATAL,
+"Invalid G specifier in FORMAT statement at %0 -- correct form: [r]Gw.d[Ee]",
+"Invalid G specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_L_SPEC, FATAL,
+"Invalid L specifier in FORMAT statement at %0 -- correct form: [r]Lw",
+"Invalid L specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_A_SPEC, FATAL,
+"Invalid A specifier in FORMAT statement at %0 -- correct form: [r]A[w]",
+"Invalid A specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_D_SPEC, FATAL,
+"Invalid D specifier in FORMAT statement at %0 -- correct form: [r]Dw.d",
+"Invalid D specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_Q_SPEC, FATAL,
+"Invalid Q specifier in FORMAT statement at %0 -- correct form: Q",
+"Invalid Q specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_DOLLAR_SPEC, FATAL,
+"Invalid $ specifier in FORMAT statement at %0 -- correct form: $",
+"Invalid $ specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_P_SPEC, FATAL,
+"Invalid P specifier in FORMAT statement at %0 -- correct form: kP",
+"Invalid P specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_T_SPEC, FATAL,
+"Invalid T specifier in FORMAT statement at %0 -- correct form: Tn",
+"Invalid T specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_TL_SPEC, FATAL,
+"Invalid TL specifier in FORMAT statement at %0 -- correct form: TLn",
+"Invalid TL specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_TR_SPEC, FATAL,
+"Invalid TR specifier in FORMAT statement at %0 -- correct form: TRn",
+"Invalid TR specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_X_SPEC, FATAL,
+"Invalid X specifier in FORMAT statement at %0 -- correct form: nX",
+"Invalid X specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_S_SPEC, FATAL,
+"Invalid S specifier in FORMAT statement at %0 -- correct form: S",
+"Invalid S specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_SP_SPEC, FATAL,
+"Invalid SP specifier in FORMAT statement at %0 -- correct form: SP",
+"Invalid SP specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_SS_SPEC, FATAL,
+"Invalid SS specifier in FORMAT statement at %0 -- correct form: SS",
+"Invalid SS specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_BN_SPEC, FATAL,
+"Invalid BN specifier in FORMAT statement at %0 -- correct form: BN",
+"Invalid BN specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_BZ_SPEC, FATAL,
+"Invalid BZ specifier in FORMAT statement at %0 -- correct form: BZ",
+"Invalid BZ specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_COLON_SPEC, FATAL,
+"Invalid : specifier in FORMAT statement at %0 -- correct form: :",
+"Invalid : specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_H_SPEC, FATAL,
+"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)",
+"Invalid H specifier in FORMAT statement at %0")
+FFEBAD_MSGS1 (FFEBAD_FORMAT_MISSING_PAREN, FATAL,
+"Missing close-parenthese(s) in FORMAT statement at %0")
+FFEBAD_MSGS1 (FFEBAD_FORMAT_MISSING_DOT, FATAL,
+"Missing number following period in FORMAT statement at %0")
+FFEBAD_MSGS1 (FFEBAD_FORMAT_MISSING_EXP, FATAL,
+"Missing number following `E' in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_EXPR_TOKEN, FATAL,
+"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",
+"Invalid token with FORMAT run-time expression at %0")
+FFEBAD_MSGS1 (FFEBAD_TRAILING_COMMA, WARN,
+"Spurious trailing comma preceding terminator at %0")
+FFEBAD_MSGS1 (FFEBAD_INTERFACE_ASSIGNMENT, WARN,
+"At %0, specify OPERATOR instead of ASSIGNMENT for INTERFACE statement not specifying the assignment operator (=)")
+FFEBAD_MSGS1 (FFEBAD_INTERFACE_OPERATOR, WARN,
+"At %0, specify ASSIGNMENT instead of OPERATOR for INTERFACE statement specifying the assignment operator (=)")
+FFEBAD_MSGS2 (FFEBAD_INTERFACE_NONLETTER, FATAL,
+"Defined operator at %0 contains a nonletter -- must contain only letters A-Z (or a-z)",
+"Nonletter in defined operator at %0")
+FFEBAD_MSGS2 (FFEBAD_INVALID_TYPEDECL_ATTR, FATAL,
+"Invalid type-declaration attribute at %0 -- must be one of: DIMENSION(array-spec), EXTERNAL, INTRINSIC, PARAMETER, or SAVE",
+"Invalid type-declaration attribute at %0")
+FFEBAD_MSGS1 (FFEBAD_INVALID_TYPEDECL_INIT, FATAL,
+"Cannot specify =initialization-expr at %0 unless `::' appears before list of objects")
+FFEBAD_MSGS1 (FFEBAD_LABEL_USE_DEF, FATAL,
+"Reference to label at %1 inconsistent with its definition at %0")
+FFEBAD_MSGS1 (FFEBAD_LABEL_USE_USE, FATAL,
+"Reference to label at %1 inconsistent with earlier reference at %0")
+FFEBAD_MSGS1 (FFEBAD_LABEL_DEF_DO, FATAL,
+"DO-statement reference to label at %1 follows its definition at %0")
+FFEBAD_MSGS1 (FFEBAD_LABEL_BLOCK, WARN,
+"Reference to label at %1 is outside block containing definition at %0")
+FFEBAD_MSGS1 (FFEBAD_LABEL_DO_BLOCK_DO, FATAL,
+"DO-statement references to label at %0 and %2 separated by unterminated block starting at %1")
+FFEBAD_MSGS1 (FFEBAD_LABEL_DO_BLOCK_END, FATAL,
+"DO-statement reference to label at %0 and label definition at %2 separated by unterminated block starting at %1")
+FFEBAD_MSGS1 (FFEBAD_INVALID_LABEL_DEF, FATAL,
+"Label definition at %0 invalid on this kind of statement")
+FFEBAD_MSGS1 (FFEBAD_ORDER_1, FATAL,
+"Statement at %0 invalid in this context")
+FFEBAD_MSGS1 (FFEBAD_ORDER_2, FATAL,
+"Statement at %0 invalid in context established by statement at %1")
+FFEBAD_MSGS1 (FFEBAD_CONSTRUCT_NAMED, FATAL,
+"Statement at %0 must specify construct name specified at %1")
+FFEBAD_MSGS1 (FFEBAD_CONSTRUCT_NOT_NAMED, FATAL,
+"Construct name at %0 superfluous, no construct name specified at %1")
+FFEBAD_MSGS1 (FFEBAD_CONSTRUCT_WRONG_NAME, FATAL,
+"Construct name at %0 not the same as construct name at %1")
+FFEBAD_MSGS1 (FFEBAD_CONSTRUCT_NO_DO_NAME, FATAL,
+"Construct name at %0 does not match construct name for any containing DO constructs")
+FFEBAD_MSGS1 (FFEBAD_DO_HAD_LABEL, FATAL,
+"Label definition missing at %0 for DO construct specifying label at %1")
+FFEBAD_MSGS1 (FFEBAD_AFTER_ELSE, FATAL,
+"Statement at %0 follows ELSE block for IF construct at %1")
+FFEBAD_MSGS1 (FFEBAD_FORMAT_NO_LABEL_DEF, FATAL,
+"No label definition for FORMAT statement at %0")
+FFEBAD_MSGS1 (FFEBAD_SECOND_ELSE_WHERE, FATAL,
+"Second occurrence of ELSE WHERE at %0 within WHERE at %1")
+FFEBAD_MSGS1 (FFEBAD_END_WO, WARN,
+"END statement at %0 missing `%A' keyword required for internal or module procedure(s) bounded by %1")
+FFEBAD_MSGS1 (FFEBAD_INVALID_MODULE_PROCEDURE, FATAL,
+"MODULE PROCEDURE statement at %0 disallowed because INTERFACE at %1 specifies no generic name, operator, or assignment")
+FFEBAD_MSGS1 (FFEBAD_BLOCKDATA_NOT_NAMED, FATAL,
+"BLOCK DATA name at %0 superfluous, no name specified at %1")
+FFEBAD_MSGS1 (FFEBAD_PROGRAM_NOT_NAMED, FATAL,
+"Program name at %0 superfluous, no PROGRAM statement specified at %1")
+FFEBAD_MSGS1 (FFEBAD_UNIT_WRONG_NAME, FATAL,
+"Program unit name at %0 not the same as name at %1")
+FFEBAD_MSGS1 (FFEBAD_TYPE_WRONG_NAME, FATAL,
+"Type name at %0 not the same as name at %1")
+FFEBAD_MSGS1 (FFEBAD_EOF_BEFORE_BLOCK_END, FATAL,
+"End of source file before end of block started at %0")
+FFEBAD_MSGS1 (FFEBAD_UNDEF_LABEL, FATAL,
+"Undefined label, first referenced at %0")
+FFEBAD_MSGS1 (FFEBAD_CONFLICTING_SAVES, WARN,
+"SAVE statement or attribute at %1 cannot be specified along with SAVE statement or attribute at %0")
+FFEBAD_MSGS1 (FFEBAD_CONFLICTING_ACCESSES, FATAL,
+"PUBLIC or PRIVATE statement at %1 cannot be specified along with PUBLIC or PRIVATE statement at %0")
+FFEBAD_MSGS1 (FFEBAD_RETURN_IN_MAIN, WARN,
+"RETURN statement at %0 invalid within a main program unit")
+FFEBAD_MSGS1 (FFEBAD_ALTRETURN_IN_PROGRAM, FATAL,
+"Alternate return specifier at %0 invalid within a main program unit")
+FFEBAD_MSGS1 (FFEBAD_ALTRETURN_IN_FUNCTION, FATAL,
+"Alternate return specifier at %0 invalid within a function")
+FFEBAD_MSGS1 (FFEBAD_DERIVTYP_ACCESS, FATAL,
+"Access specifier or PRIVATE statement at %0 invalid for derived-type definition within other than the specification part of a module")
+FFEBAD_MSGS1 (FFEBAD_DERIVTYP_ACCESS_FIRST, FATAL,
+"Access specifier at %0 must immediately follow derived-type statement at %1 with no intervening statements")
+FFEBAD_MSGS1 (FFEBAD_DERIVTYP_NO_COMPONENTS, FATAL,
+"No components specified as of %0 for derived-type definition beginning at %1")
+FFEBAD_MSGS1 (FFEBAD_STRUCT_NO_COMPONENTS, FATAL,
+"No components specified as of %0 for structure definition beginning at %1")
+FFEBAD_MSGS1 (FFEBAD_STRUCT_MISSING_NAME, FATAL,
+"Missing structure name for outer structure definition at %0")
+FFEBAD_MSGS1 (FFEBAD_STRUCT_IGNORING_FIELD, FATAL,
+"Field names at %0 for outer structure definition -- specify them in a subsequent RECORD statement instead")
+FFEBAD_MSGS1 (FFEBAD_STRUCT_MISSING_FIELD, FATAL,
+"Missing field name(s) for structure definition at %0 within structure definition at %1")
+FFEBAD_MSGS1 (FFEBAD_MAP_NO_COMPONENTS, FATAL,
+"No components specified as of %0 for map beginning at %1")
+FFEBAD_MSGS1 (FFEBAD_UNION_NO_TWO_MAPS, FATAL,
+"Zero or one maps specified as of %0 for union beginning at %1 -- at least two are required")
+FFEBAD_MSGS1 (FFEBAD_MISSING_SPECIFIER, FATAL,
+"Missing %A specifier in statement at %0")
+FFEBAD_MSGS1 (FFEBAD_NAMELIST_ITEMS, FATAL,
+"Items in I/O list starting at %0 invalid for namelist-directed I/O")
+FFEBAD_MSGS1 (FFEBAD_CONFLICTING_SPECS, FATAL,
+"Conflicting I/O control specifications at %0 and %1")
+FFEBAD_MSGS1 (FFEBAD_NO_UNIT_SPEC, FATAL,
+"No UNIT= specifier in I/O control list at %0")
+FFEBAD_MSGS1 (FFEBAD_MISSING_ADVANCE_SPEC, FATAL,
+"Specification at %0 requires ADVANCE=`NO' specification in same I/O control list")
+FFEBAD_MSGS1 (FFEBAD_MISSING_FORMAT_SPEC, FATAL,
+"Specification at %0 requires explicit FMT= specification in same I/O control list")
+FFEBAD_MSGS2 (FFEBAD_SPEC_VALUE, FATAL,
+"Unrecognized value for character constant at %0 -- expecting %A",
+"Unrecognized value for character constant at %0")
+FFEBAD_MSGS1 (FFEBAD_CASE_SECOND_DEFAULT, FATAL,
+"Second occurrence of CASE DEFAULT at %0 within SELECT CASE at %1")
+FFEBAD_MSGS1 (FFEBAD_CASE_DUPLICATE, FATAL,
+"Duplicate or overlapping case values/ranges at %0 and %1")
+FFEBAD_MSGS1 (FFEBAD_CASE_TYPE_DISAGREE, FATAL,
+"Type and/or kind-type parameter disagreement between CASE value or value within range at %0 and SELECT CASE at %1")
+FFEBAD_MSGS1 (FFEBAD_CASE_LOGICAL_RANGE, FATAL,
+"Range specification at %0 invalid for CASE statement within logical-type SELECT CASE statement")
+FFEBAD_MSGS2 (FFEBAD_CASE_BAD_RANGE, FATAL,
+"Range specification at %0 invalid -- at least one expression must be specified, or use CASE DEFAULT",
+"Range specification at %0 invalid")
+FFEBAD_MSGS2 (FFEBAD_CASE_RANGE_USELESS, INFORM,
+"Range specification at %0 useless; first expression greater than second expression in range, so range can never be matched by any selection expression",
+"Useless range at %0")
+FFEBAD_MSGS1 (FFEBAD_F90, FATAL,
+"Fortran 90 feature at %0 unsupported")
+FFEBAD_MSGS2 (FFEBAD_KINDTYPE, FATAL,
+"Invalid kind at %0 for type at %1 -- unsupported or not permitted",
+"Invalid kind at %0 for type at %1")
+FFEBAD_MSGS2 (FFEBAD_BAD_IMPLICIT, FATAL,
+"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",
+"Cannot establish implicit type for initial letter `%A' at %0")
+FFEBAD_MSGS1 (FFEBAD_SYMERR, FATAL,
+"Invalid declaration of or reference to symbol `%A' at %0 [initially seen at %1]")
+FFEBAD_MSGS2 (FFEBAD_LABEL_WRONG_PLACE, FATAL,
+"Label definition %A (at %0) invalid -- must be in columns 1-5",
+"Invalid label definition %A (at %0)")
+FFEBAD_MSGS1 (FFEBAD_NULL_ELEMENT, FATAL,
+"Null element at %0 for array reference at %1")
+FFEBAD_MSGS1 (FFEBAD_TOO_FEW_ELEMENTS, FATAL,
+"Too few elements (%A missing) as of %0 for array reference at %1")
+FFEBAD_MSGS1 (FFEBAD_TOO_MANY_ELEMENTS, FATAL,
+"Too many elements as of %0 for array reference at %1")
+FFEBAD_MSGS1 (FFEBAD_MISSING_COLON_IN_SUBSTR, FATAL,
+"Missing colon as of %0 in substring reference for %1")
+FFEBAD_MSGS1 (FFEBAD_BAD_SUBSTR, FATAL,
+"Invalid use at %0 of substring operator on %1")
+FFEBAD_MSGS1 (FFEBAD_RANGE_SUBSTR, WARN,
+"Substring begin/end point at %0 out of defined range")
+FFEBAD_MSGS1 (FFEBAD_RANGE_ARRAY, WARN,
+"Array element value at %0 out of defined range")
+FFEBAD_MSGS1 (FFEBAD_EXPR_WRONG, FATAL,
+"Expression at %0 has incorrect data type or rank for its context")
+FFEBAD_MSGS1 (FFEBAD_DIV_BY_ZERO, WARN,
+"Division by 0 (zero) at %0 (IEEE not yet supported)")
+FFEBAD_MSGS1 (FFEBAD_DO_STEP_ZERO, FATAL,
+"%A step count known to be 0 (zero) at %0")
+FFEBAD_MSGS1 (FFEBAD_DO_END_OVERFLOW, WARN,
+"%A end value plus step count known to overflow at %0")
+FFEBAD_MSGS1 (FFEBAD_DO_IMP_OVERFLOW, WARN,
+"%A begin, end, and step-count values known to result in implementation-dependent behavior due to overflow(s) in intermediate calculations at %0")
+FFEBAD_MSGS1 (FFEBAD_DO_NULL, WARN,
+"%A begin, end, and step-count values known to result in no iterations at %0")
+FFEBAD_MSGS1 (FFEBAD_BAD_TYPES, FATAL,
+"Type disagreement between expressions at %0 and %1")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_EXPR_SPEC, FATAL,
+"Run-time expression at %0 in FORMAT statement that does not follow the first executable statement in the program unit -- move the statement",
+"FORMAT at %0 with run-time expression must follow first executable statement")
+FFEBAD_MSGS2 (FFEBAD_BAD_IMPDO, FATAL,
+"Unexpected token at %0 in implied-DO construct at %1 -- form of implied-DO is `(item-list,do-var=start,end[,incr])'",
+"Unexpected token at %0 in implied-DO construct at %1")
+FFEBAD_MSGS1 (FFEBAD_BAD_IMPDCL, FATAL,
+"No specification for implied-DO iterator `%A' at %0")
+FFEBAD_MSGS1 (FFEBAD_IMPDO_PAREN, WARN,
+"Gratuitous parentheses surround implied-DO construct at %0")
+FFEBAD_MSGS1 (FFEBAD_ZERO_SIZE, FATAL,
+"Zero-size specification invalid at %0")
+FFEBAD_MSGS1 (FFEBAD_ZERO_ARRAY, FATAL,
+"Zero-size array at %0")
+FFEBAD_MSGS1 (FFEBAD_BAD_COMPLEX, FATAL,
+"Target machine does not support complex entity of kind specified at %0")
+FFEBAD_MSGS1 (FFEBAD_BAD_DBLCMPLX, FATAL,
+"Target machine does not support DOUBLE COMPLEX, specified at %0")
+FFEBAD_MSGS1 (FFEBAD_BAD_POWER, WARN,
+"Attempt to raise constant zero to a power at %0")
+FFEBAD_MSGS2 (FFEBAD_BOOL_ARGS_TYPE, FATAL,
+"Boolean/logical operator at %0 must operate on two subexpressions of logical type, but neither subexpression at %1 or %2 is of logical type",
+"Invalid operands at %1 and %2 for boolean operator at %0")
+FFEBAD_MSGS2 (FFEBAD_BOOL_ARG_TYPE, FATAL,
+"Boolean/logical operator at %0 must operate on two subexpressions of logical type, but the subexpression at %1 is not of logical type",
+"Invalid operand at %1 for boolean operator at %0")
+FFEBAD_MSGS2 (FFEBAD_BOOL_ARG_KIND, FATAL,
+"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",
+"Invalid operand (is %A) at %1 for boolean operator at %0")
+FFEBAD_MSGS2 (FFEBAD_NOT_ARG_TYPE, FATAL,
+".NOT. operator at %0 must operate on subexpression of logical type, but the subexpression at %1 is not of logical type",
+"Invalid operand at %1 for .NOT. operator at %0")
+FFEBAD_MSGS2 (FFEBAD_NOT_ARG_KIND, FATAL,
+".NOT. operator at %0 must operate on scalar subexpressions -- but the subexpression at %1 is %A",
+"Invalid operand (is %A) at %1 for .NOT. operator at %0")
+FFEBAD_MSGS2 (FFEBAD_EQOP_ARGS_TYPE, FATAL,
+"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",
+"Invalid operands at %1 and %2 for equality operator at %0")
+FFEBAD_MSGS2 (FFEBAD_EQOP_ARG_TYPE, FATAL,
+"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",
+"Invalid operand at %1 for equality operator at %0")
+FFEBAD_MSGS2 (FFEBAD_EQOP_ARG_KIND, FATAL,
+"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",
+"Invalid operand (is %A) at %1 for equality operator at %0")
+FFEBAD_MSGS2 (FFEBAD_RELOP_ARGS_TYPE, FATAL,
+"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",
+"Invalid operands at %1 and %2 for relational operator at %0")
+FFEBAD_MSGS2 (FFEBAD_RELOP_ARG_TYPE, FATAL,
+"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",
+"Invalid operand at %1 for relational operator at %0")
+FFEBAD_MSGS2 (FFEBAD_RELOP_ARG_KIND, FATAL,
+"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",
+"Invalid operand (is %A) at %1 for relational operator at %0")
+FFEBAD_MSGS2 (FFEBAD_INTRINSIC_REF, FATAL,
+"Reference to intrinsic `%A' at %0 invalid -- one or more arguments have incorrect type",
+"Invalid reference to intrinsic `%A' at %0")
+FFEBAD_MSGS2 (FFEBAD_INTRINSIC_TOOFEW, FATAL,
+"Too few arguments passed to intrinsic `%A' at %0",
+"Too few arguments for intrinsic `%A' at %0")
+FFEBAD_MSGS2 (FFEBAD_INTRINSIC_TOOMANY, FATAL,
+"Too many arguments passed to intrinsic `%A' at %0",
+"Too many arguments for intrinsic `%A' at %0")
+FFEBAD_MSGS2 (FFEBAD_INTRINSIC_DISABLED, FATAL,
+"Reference to disabled intrinsic `%A' at %0",
+"Disabled intrinsic `%A' at %0")
+FFEBAD_MSGS2 (FFEBAD_INTRINSIC_IS_SUBR, FATAL,
+"Reference to intrinsic subroutine `%A' as if it were a function at %0",
+"Function reference to intrinsic subroutine `%A' at %0")
+FFEBAD_MSGS2 (FFEBAD_INTRINSIC_IS_FUNC, FATAL,
+"Reference to intrinsic function `%A' as if it were a subroutine at %0",
+"Subroutine reference to intrinsic function `%A' at %0")
+FFEBAD_MSGS2 (FFEBAD_INTRINSIC_UNIMPL, FATAL,
+"Reference to unimplemented intrinsic `%A' at %0 -- use EXTERNAL to reference user-written procedure with this name",
+"Unimplemented intrinsic `%A' at %0")
+FFEBAD_MSGS2 (FFEBAD_INTRINSIC_UNIMPLW, WARN,
+"Reference to unimplemented intrinsic `%A' at %0 (assumed EXTERNAL)",
+"Unimplemented intrinsic `%A' at %0 (assumed EXTERNAL)")
+FFEBAD_MSGS1 (FFEBAD_INTRINSIC_AMBIG, FATAL,
+"Reference to generic intrinsic `%A' at %0 could be to form %B or %C")
+FFEBAD_MSGS1 (FFEBAD_INTRINSIC_CMPAMBIG, FATAL,
+"Ambiguous use of intrinsic `%A' at %0 [info -f g77 M CMPAMBIG]")
+FFEBAD_MSGS1 (FFEBAD_INTRINSIC_EXPIMP, WARN,
+"Intrinsic `%A' referenced %Bly at %0, %Cly at %1 [info -f g77 M EXPIMP]")
+FFEBAD_MSGS1 (FFEBAD_INTRINSIC_GLOBAL, WARN,
+"Same name `%A' used for %B at %0 and %C at %1 [info -f g77 M INTGLOB]")
+FFEBAD_MSGS1 (FFEBAD_INTRINSIC_TYPE, WARN,
+"Explicit type declaration for intrinsic `%A' disagrees with invocation at %0")
+FFEBAD_MSGS1 (FFEBAD_OPEN_INCLUDE, FATAL,
+"Unable to open INCLUDE file `%A' at %0")
+FFEBAD_MSGS2 (FFEBAD_DOITER, FATAL,
+"Attempt to modify variable `%A' at %0 while it serves as DO-loop iterator at %1",
+"Modification of DO-loop iterator `%A' at %0")
+FFEBAD_MSGS2 (FFEBAD_DOITER_IMPDO, FATAL,
+"Attempt to modify variable `%A' via item #%B in list at %0 while it serves as implied-DO iterator at %1",
+"Modification of DO-loop iterator `%A' at %0")
+FFEBAD_MSGS2 (FFEBAD_TOO_MANY_DIMS, FATAL,
+"Array has too many dimensions, as of dimension specifier at %0",
+"Too many dimensions at %0")
+FFEBAD_MSGS1 (FFEBAD_NULL_ARGUMENT, FATAL,
+"Null argument at %0 for statement function reference at %1")
+FFEBAD_MSGS1 (FFEBAD_TOO_FEW_ARGUMENTS, FATAL,
+"%A too few arguments (starting with dummy argument `%B') as of %0 for statement function reference at %1")
+FFEBAD_MSGS1 (FFEBAD_TOO_MANY_ARGUMENTS, FATAL,
+"%A too many arguments as of %0 for statement function reference at %1")
+FFEBAD_MSGS1 (FFEBAD_ARRAY_AS_SFARG, FATAL,
+"Array supplied at %1 for dummy argument `%A' in statement function reference at %0")
+FFEBAD_MSGS1 (FFEBAD_FORMAT_UNSUPPORTED, FATAL,
+"Unsupported FORMAT specifier at %0")
+FFEBAD_MSGS2 (FFEBAD_OPEN_UNSUPPORTED, WARN,
+"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",
+"Unsupported OPEN control item at %0")
+FFEBAD_MSGS2 (FFEBAD_INQUIRE_UNSUPPORTED, WARN,
+"Unsupported INQUIRE control item at %0 -- ACTION=, CARRIAGECONTROL=, DEFAULTFILE=, DELIM=, KEYED=, ORGANIZATION=, PAD=, POSITION=, READ=, READWRITE=, RECORDTYPE=, and WRITE= are not supported",
+"Unsupported INQUIRE control item at %0")
+FFEBAD_MSGS2 (FFEBAD_READ_UNSUPPORTED, WARN,
+"Unsupported READ control item at %0 -- ADVANCE=, EOR=, KEYEQ=, KEYGE=, KEYGT=, KEYID=, NULLS=, and SIZE= are not supported",
+"Unsupported READ control item at %0")
+FFEBAD_MSGS2 (FFEBAD_WRITE_UNSUPPORTED, WARN,
+"Unsupported WRITE control item at %0 -- ADVANCE= and EOR= are not supported",
+"Unsupported WRITE control item at %0")
+FFEBAD_MSGS1 (FFEBAD_VXT_UNSUPPORTED, FATAL,
+"Unsupported VXT statement at %0")
+FFEBAD_MSGS1 (FFEBAD_DATA_REINIT, FATAL,
+"Attempt to specify second initial value for `%A' at %0")
+FFEBAD_MSGS1 (FFEBAD_DATA_TOOFEW, FATAL,
+"Too few initial values in list of initializers for `%A' at %0")
+FFEBAD_MSGS1 (FFEBAD_DATA_TOOMANY, FATAL,
+"Too many initial values in list of initializers starting at %0")
+FFEBAD_MSGS1 (FFEBAD_DATA_RANGE, FATAL,
+"Array or substring specification for `%A' out of range in statement at %0")
+FFEBAD_MSGS1 (FFEBAD_DATA_SUBSCRIPT, FATAL,
+"Array subscript #%B out of range for initialization of `%A' in statement at %0")
+FFEBAD_MSGS1 (FFEBAD_DATA_ZERO, FATAL,
+"Implied do-loop step count of 0 (zero) for iteration variable `%A' in statement at %0")
+FFEBAD_MSGS1 (FFEBAD_DATA_EMPTY, FATAL,
+"Implied do-loop iteration count of 0 (zero) for iteration variable `%A' in statement at %0")
+FFEBAD_MSGS1 (FFEBAD_DATA_EVAL, FATAL,
+"Not an integer constant expression in implied do-loop in statement at %0")
+FFEBAD_MSGS1 (FFEBAD_DATA_MULTIPLE, FATAL,
+"Attempt to specify second initial value for element of `%A' at %0")
+FFEBAD_MSGS1 (FFEBAD_EQUIV_COMMON, FATAL,
+"Attempt to EQUIVALENCE common areas `%A' and `%B' at %0")
+FFEBAD_MSGS1 (FFEBAD_EQUIV_ALIGN, FATAL,
+"Can't place `%A' as directed by EQUIVALENCE due to alignment restrictions")
+FFEBAD_MSGS1 (FFEBAD_EQUIV_MISMATCH, FATAL,
+"Mismatched EQUIVALENCE requirements for placement of `%A' at both %C and %D bytes offset from `%B'")
+FFEBAD_MSGS1 (FFEBAD_EQUIV_RANGE, FATAL,
+"Array or substring specification for `%A' out of range in EQUIVALENCE statement")
+FFEBAD_MSGS1 (FFEBAD_EQUIV_SUBSTR, FATAL,
+"Substring of non-CHARACTER entity `%A' in EQUIVALENCE statement")
+FFEBAD_MSGS1 (FFEBAD_EQUIV_ARRAY, FATAL,
+"Array reference to scalar variable `%A' in EQUIVALENCE statement")
+FFEBAD_MSGS1 (FFEBAD_EQUIV_SUBSCRIPT, WARN,
+"Array subscript #%B out of range for EQUIVALENCE of `%A'")
+FFEBAD_MSGS2 (FFEBAD_COMMON_PAD, WARN,
+"Padding of %A %D required before `%B' in common block `%C' at %0 -- consider reordering members, largest-type-size first",
+"Padding of %A %D required before `%B' in common block `%C' at %0")
+FFEBAD_MSGS1 (FFEBAD_COMMON_NEG, FATAL,
+"Attempt to extend COMMON area beyond its starting point via EQUIVALENCE of `%A'")
+FFEBAD_MSGS1 (FFEBAD_EQUIV_FEW, FATAL,
+"Too few elements in reference to array `%A' in EQUIVALENCE statement")
+FFEBAD_MSGS1 (FFEBAD_EQUIV_MANY, FATAL,
+"Too many elements in reference to array `%A' in EQUIVALENCE statement")
+FFEBAD_MSGS1 (FFEBAD_MIXED_TYPES, WARN,
+"Mixed CHARACTER and non-CHARACTER types via COMMON/EQUIVALENCE -- for example, `%A' and `%B'")
+FFEBAD_MSGS2 (FFEBAD_IMPLICIT_ADJLEN, FATAL,
+"Invalid length specification at %0 for IMPLICIT statement -- must be integer constant expression",
+"Invalid length specification at %0")
+FFEBAD_MSGS2 (FFEBAD_ENTRY_CONFLICTS, FATAL,
+"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",
+"Type of ENTRY point at %0 to function conflicts with type(s) of previous entrypoint(s)")
+FFEBAD_MSGS1 (FFEBAD_RETURN_VALUE_UNSET, WARN,
+"Return value `%A' for FUNCTION at %0 not referenced in subprogram")
+FFEBAD_MSGS2 (FFEBAD_COMMON_ALREADY_INIT, FATAL,
+"Common block `%A' initialized at %0 already initialized at %1 -- only one program unit may specify initial values for a particular common block",
+"Common block `%A' initialized at %0 already initialized at %1")
+FFEBAD_MSGS2 (FFEBAD_COMMON_INIT_PAD, WARN,
+"Initial padding for common block `%A' is %B %C at %0 -- consider reordering members, largest-type-size first",
+"Initial padding for common block `%A' is %B %C at %0")
+FFEBAD_MSGS2 (FFEBAD_COMMON_DIFF_PAD, FATAL,
+"Initial padding for common block `%A' is %B %D at %0 but %C %E at %1 -- consider reordering members, largest-type-size first",
+"Initial padding for common block `%A' is %B %D at %0 but %C %E at %1")
+FFEBAD_MSGS1 (FFEBAD_COMMON_DIFF_SAVE, WARN,
+"Common block `%A' is SAVEd, explicitly or implicitly, at %0 but not SAVEd at %1")
+FFEBAD_MSGS1 (FFEBAD_COMMON_DIFF_SIZE, WARN,
+"Common block `%A' is %B %D in length at %0 but %C %E at %1")
+FFEBAD_MSGS2 (FFEBAD_COMMON_ENLARGED, FATAL,
+"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",
+"Common block `%A' is initialized to %B %D long at %0 but enlarged to %C %E at %1")
+FFEBAD_MSGS1 (FFEBAD_COMMON_BLANK_INIT, WARN,
+"Blank common initialized at %0")
+FFEBAD_MSGS1 (FFEBAD_NEED_INTRINSIC, WARN,
+"Intrinsic `%A' is passed as actual argument at %0 but not explicitly declared INTRINSIC")
+FFEBAD_MSGS1 (FFEBAD_NEED_EXTERNAL, WARN,
+"External procedure `%A' is passed as actual argument at %0 but not explicitly declared EXTERNAL")
+FFEBAD_MSGS1 (FFEBAD_SYMBOL_UPPER_CASE, WARN,
+"Character `%A' (for example) is upper-case in symbol name at %0")
+FFEBAD_MSGS1 (FFEBAD_SYMBOL_LOWER_CASE, WARN,
+"Character `%A' (for example) is lower-case in symbol name at %0")
+FFEBAD_MSGS1 (FFEBAD_SYMBOL_NOLOWER_INITCAP, WARN,
+"Character `%A' not followed at some point by lower-case character in symbol name at %0")
+FFEBAD_MSGS1 (FFEBAD_SYMBOL_LOWER_INITCAP, WARN,
+"Initial character `%A' is lower-case in symbol name at %0")
+FFEBAD_MSGS2 (FFEBAD_DO_REAL, WARN,
+"DO-variable `%A' is type REAL or DOUBLE PRECISION at %0 -- unexpected behavior likely",
+"DO-variable `%A' is type REAL or DOUBLE PRECISION at %0")
+FFEBAD_MSGS1 (FFEBAD_NAMELIST_CASE, WARN,
+"NAMELIST not adequately supported by run-time library for source files with case preserved")
+FFEBAD_MSGS1 (FFEBAD_NESTED_PERCENT, WARN,
+"Nested %% construct (%%VAL, %%REF, or %%DESCR) at %0")
+FFEBAD_MSGS2 (FFEBAD_ACTUALARG, WARN,
+"Invalid actual argument at %0 -- replace hollerith constants with %%REF('string') and typeless constants with INTEGER constant equivalents, or use -fugly-args or -fugly",
+"Invalid actual argument at %0")
+FFEBAD_MSGS2 (FFEBAD_QUAD_UNSUPPORTED, WARN,
+"Quadruple-precision floating-point unsupported -- treating constant at %0 as double-precision",
+"Quadruple-precision floating-point unsupported")
+FFEBAD_MSGS2 (FFEBAD_TOO_BIG_INIT, WARN,
+"Initialization of large (%B-unit) aggregate area `%A' at %0 currently very slow and takes lots of memory during g77 compile -- to be improved in 0.6",
+"This could take a while (initializing `%A' at %0)...")
+FFEBAD_MSGS1 (FFEBAD_BLOCKDATA_STMT, WARN,
+"Statement at %0 invalid in BLOCK DATA program unit at %1")
+FFEBAD_MSGS1 (FFEBAD_TRUNCATING_CHARACTER, WARN,
+"Truncating characters on right side of character constant at %0")
+FFEBAD_MSGS1 (FFEBAD_TRUNCATING_HOLLERITH, WARN,
+"Truncating characters on right side of hollerith constant at %0")
+FFEBAD_MSGS1 (FFEBAD_TRUNCATING_NUMERIC, WARN,
+"Truncating non-zero data on left side of numeric constant at %0")
+FFEBAD_MSGS1 (FFEBAD_TRUNCATING_TYPELESS, WARN,
+"Truncating non-zero data on left side of typeless constant at %0")
+FFEBAD_MSGS1 (FFEBAD_TYPELESS_OVERFLOW, WARN,
+"Typeless constant at %0 too large")
+FFEBAD_MSGS1 (FFEBAD_AMPERSAND, WARN,
+"First-column ampersand continuation at %0")
+FFEBAD_MSGS1 (FFEBAD_FILEWIDE_ALREADY_SEEN, FATAL,
+"Global name `%A' defined at %0 already defined at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSGS1 (FFEBAD_FILEWIDE_ALREADY_SEEN_W, WARN,
+"Global name `%A' defined at %0 already defined at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSGS1 (FFEBAD_FILEWIDE_DISAGREEMENT, FATAL,
+"Global name `%A' is %B at %0 but is %C at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSGS1 (FFEBAD_FILEWIDE_DISAGREEMENT_W, WARN,
+"Global name `%A' is %B at %0 but is %C at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSGS1 (FFEBAD_FILEWIDE_TYPE_MISMATCH, FATAL,
+"Global name `%A' at %0 has different type at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSGS1 (FFEBAD_FILEWIDE_TYPE_MISMATCH_W, WARN,
+"Global name `%A' at %0 has different type at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSGS1 (FFEBAD_FILEWIDE_NARGS, FATAL,
+"Too %B arguments passed to `%A' at %0 versus definition at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSGS1 (FFEBAD_FILEWIDE_NARGS_W, WARN,
+"Too %B arguments for `%A' at %0 versus invocation at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSGS1 (FFEBAD_FILEWIDE_ARG, FATAL,
+"Argument #%B of `%A' is %C at %0 but is %D at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSGS1 (FFEBAD_FILEWIDE_ARG_W, WARN,
+"Argument #%B of `%A' is %C at %0 but is %D at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSGS1 (FFEBAD_ARRAY_LARGE, FATAL,
+"Array `%A' at %0 is too large to handle")
+
+#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
new file mode 100644
index 00000000000..cdbf32c007c
--- /dev/null
+++ b/gcc/f/bad.h
@@ -0,0 +1,108 @@
+/* bad.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_bad
+#define _H_f_bad
+
+/* Simple definitions and enumerations. */
+
+typedef enum
+  {
+#define FFEBAD_MSGS1(KWD,SEV,MSG) KWD,
+#define FFEBAD_MSGS2(KWD,SEV,LMSG,SMSG) KWD,
+#include "bad.def"
+#undef FFEBAD_MSGS1
+#undef FFEBAD_MSGS2
+    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,
+		    char *message);
+void ffebad_string (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(m,s) ffebad_start_ (FALSE, FFEBAD, (s), (m))
+#define ffebad_start_msg_lex(m,s) ffebad_start_ (TRUE, FFEBAD, (s), (m))
+#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
diff --git a/gcc/f/bit.c b/gcc/f/bit.c
new file mode 100644
index 00000000000..864d601665b
--- /dev/null
+++ b/gcc/f/bit.c
@@ -0,0 +1,201 @@
+/* bit.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 "glimits.j"
+#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
new file mode 100644
index 00000000000..cb7357fa1bb
--- /dev/null
+++ b/gcc/f/bit.h
@@ -0,0 +1,84 @@
+/* bit.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_bit
+#define _H_f_bit
+
+/* 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
diff --git a/gcc/f/bld-op.def b/gcc/f/bld-op.def
new file mode 100644
index 00000000000..adaec06673c
--- /dev/null
+++ b/gcc/f/bld-op.def
@@ -0,0 +1,69 @@
+/* bld-op.def -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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
new file mode 100644
index 00000000000..3a95727adc1
--- /dev/null
+++ b/gcc/f/bld.c
@@ -0,0 +1,5782 @@
+/* bld.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 <ctype.h>
+#include "bld.h"
+#include "bit.h"
+#include "info.h"
+#include "lex.h"
+#include "malloc.h"
+#include "target.h"
+#include "where.h"
+
+/* Externals defined here.  */
+
+ffebldArity ffebld_arity_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 FFEBLD_BLANK_
+static struct _ffebld_ ffebld_blank_
+=
+{
+  0,
+  {FFEINFO_basictypeNONE, FFEINFO_kindtypeNONE, 0, FFEINFO_kindNONE,
+   FFEINFO_whereNONE, FFETARGET_charactersizeNONE},
+  {NULL, NULL}
+};
+#endif
+#if FFETARGET_okCHARACTER1
+static ffebldConstant ffebld_constant_character1_;
+#endif
+#if FFETARGET_okCHARACTER2
+static ffebldConstant ffebld_constant_character2_;
+#endif
+#if FFETARGET_okCHARACTER3
+static ffebldConstant ffebld_constant_character3_;
+#endif
+#if FFETARGET_okCHARACTER4
+static ffebldConstant ffebld_constant_character4_;
+#endif
+#if FFETARGET_okCHARACTER5
+static ffebldConstant ffebld_constant_character5_;
+#endif
+#if FFETARGET_okCHARACTER6
+static ffebldConstant ffebld_constant_character6_;
+#endif
+#if FFETARGET_okCHARACTER7
+static ffebldConstant ffebld_constant_character7_;
+#endif
+#if FFETARGET_okCHARACTER8
+static ffebldConstant ffebld_constant_character8_;
+#endif
+#if FFETARGET_okCOMPLEX1
+static ffebldConstant ffebld_constant_complex1_;
+#endif
+#if FFETARGET_okCOMPLEX2
+static ffebldConstant ffebld_constant_complex2_;
+#endif
+#if FFETARGET_okCOMPLEX3
+static ffebldConstant ffebld_constant_complex3_;
+#endif
+#if FFETARGET_okCOMPLEX4
+static ffebldConstant ffebld_constant_complex4_;
+#endif
+#if FFETARGET_okCOMPLEX5
+static ffebldConstant ffebld_constant_complex5_;
+#endif
+#if FFETARGET_okCOMPLEX6
+static ffebldConstant ffebld_constant_complex6_;
+#endif
+#if FFETARGET_okCOMPLEX7
+static ffebldConstant ffebld_constant_complex7_;
+#endif
+#if FFETARGET_okCOMPLEX8
+static ffebldConstant ffebld_constant_complex8_;
+#endif
+#if FFETARGET_okINTEGER1
+static ffebldConstant ffebld_constant_integer1_;
+#endif
+#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_okINTEGER5
+static ffebldConstant ffebld_constant_integer5_;
+#endif
+#if FFETARGET_okINTEGER6
+static ffebldConstant ffebld_constant_integer6_;
+#endif
+#if FFETARGET_okINTEGER7
+static ffebldConstant ffebld_constant_integer7_;
+#endif
+#if FFETARGET_okINTEGER8
+static ffebldConstant ffebld_constant_integer8_;
+#endif
+#if FFETARGET_okLOGICAL1
+static ffebldConstant ffebld_constant_logical1_;
+#endif
+#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_okLOGICAL5
+static ffebldConstant ffebld_constant_logical5_;
+#endif
+#if FFETARGET_okLOGICAL6
+static ffebldConstant ffebld_constant_logical6_;
+#endif
+#if FFETARGET_okLOGICAL7
+static ffebldConstant ffebld_constant_logical7_;
+#endif
+#if FFETARGET_okLOGICAL8
+static ffebldConstant ffebld_constant_logical8_;
+#endif
+#if FFETARGET_okREAL1
+static ffebldConstant ffebld_constant_real1_;
+#endif
+#if FFETARGET_okREAL2
+static ffebldConstant ffebld_constant_real2_;
+#endif
+#if FFETARGET_okREAL3
+static ffebldConstant ffebld_constant_real3_;
+#endif
+#if FFETARGET_okREAL4
+static ffebldConstant ffebld_constant_real4_;
+#endif
+#if FFETARGET_okREAL5
+static ffebldConstant ffebld_constant_real5_;
+#endif
+#if FFETARGET_okREAL6
+static ffebldConstant ffebld_constant_real6_;
+#endif
+#if FFETARGET_okREAL7
+static ffebldConstant ffebld_constant_real7_;
+#endif
+#if FFETARGET_okREAL8
+static ffebldConstant ffebld_constant_real8_;
+#endif
+static ffebldConstant ffebld_constant_hollerith_;
+static ffebldConstant ffebld_constant_typeless_[FFEBLD_constTYPELESS_LAST
+					  - FFEBLD_constTYPELESS_FIRST + 1];
+
+static char *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_okINTEGER5
+    case FFEBLD_constINTEGER5:
+      return ffetarget_cmp_integer5 (ffebld_constant_integer5 (c1),
+				     ffebld_constant_integer5 (c2));
+#endif
+
+#if FFETARGET_okINTEGER6
+    case FFEBLD_constINTEGER6:
+      return ffetarget_cmp_integer6 (ffebld_constant_integer6 (c1),
+				     ffebld_constant_integer6 (c2));
+#endif
+
+#if FFETARGET_okINTEGER7
+    case FFEBLD_constINTEGER7:
+      return ffetarget_cmp_integer7 (ffebld_constant_integer7 (c1),
+				     ffebld_constant_integer7 (c2));
+#endif
+
+#if FFETARGET_okINTEGER8
+    case FFEBLD_constINTEGER8:
+      return ffetarget_cmp_integer8 (ffebld_constant_integer8 (c1),
+				     ffebld_constant_integer8 (c2));
+#endif
+
+#if FFETARGET_okLOGICAL1
+    case FFEBLD_constLOGICAL1:
+      return ffetarget_cmp_logical1 (ffebld_constant_logical1 (c1),
+				     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_okLOGICAL5
+    case FFEBLD_constLOGICAL5:
+      return ffetarget_cmp_logical5 (ffebld_constant_logical5 (c1),
+				     ffebld_constant_logical5 (c2));
+#endif
+
+#if FFETARGET_okLOGICAL6
+    case FFEBLD_constLOGICAL6:
+      return ffetarget_cmp_logical6 (ffebld_constant_logical6 (c1),
+				     ffebld_constant_logical6 (c2));
+#endif
+
+#if FFETARGET_okLOGICAL7
+    case FFEBLD_constLOGICAL7:
+      return ffetarget_cmp_logical7 (ffebld_constant_logical7 (c1),
+				     ffebld_constant_logical7 (c2));
+#endif
+
+#if FFETARGET_okLOGICAL8
+    case FFEBLD_constLOGICAL8:
+      return ffetarget_cmp_logical8 (ffebld_constant_logical8 (c1),
+				     ffebld_constant_logical8 (c2));
+#endif
+
+#if FFETARGET_okREAL1
+    case FFEBLD_constREAL1:
+      return ffetarget_cmp_real1 (ffebld_constant_real1 (c1),
+				  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_okREAL4
+    case FFEBLD_constREAL4:
+      return ffetarget_cmp_real4 (ffebld_constant_real4 (c1),
+				  ffebld_constant_real4 (c2));
+#endif
+
+#if FFETARGET_okREAL5
+    case FFEBLD_constREAL5:
+      return ffetarget_cmp_real5 (ffebld_constant_real5 (c1),
+				  ffebld_constant_real5 (c2));
+#endif
+
+#if FFETARGET_okREAL6
+    case FFEBLD_constREAL6:
+      return ffetarget_cmp_real6 (ffebld_constant_real6 (c1),
+				  ffebld_constant_real6 (c2));
+#endif
+
+#if FFETARGET_okREAL7
+    case FFEBLD_constREAL7:
+      return ffetarget_cmp_real7 (ffebld_constant_real7 (c1),
+				  ffebld_constant_real7 (c2));
+#endif
+
+#if FFETARGET_okREAL8
+    case FFEBLD_constREAL8:
+      return ffetarget_cmp_real8 (ffebld_constant_real8 (c1),
+				  ffebld_constant_real8 (c2));
+#endif
+
+#if FFETARGET_okCHARACTER1
+    case FFEBLD_constCHARACTER1:
+      return ffetarget_cmp_character1 (ffebld_constant_character1 (c1),
+				       ffebld_constant_character1 (c2));
+#endif
+
+#if FFETARGET_okCHARACTER2
+    case FFEBLD_constCHARACTER2:
+      return ffetarget_cmp_character2 (ffebld_constant_character2 (c1),
+				       ffebld_constant_character2 (c2));
+#endif
+
+#if FFETARGET_okCHARACTER3
+    case FFEBLD_constCHARACTER3:
+      return ffetarget_cmp_character3 (ffebld_constant_character3 (c1),
+				       ffebld_constant_character3 (c2));
+#endif
+
+#if FFETARGET_okCHARACTER4
+    case FFEBLD_constCHARACTER4:
+      return ffetarget_cmp_character4 (ffebld_constant_character4 (c1),
+				       ffebld_constant_character4 (c2));
+#endif
+
+#if FFETARGET_okCHARACTER5
+    case FFEBLD_constCHARACTER5:
+      return ffetarget_cmp_character5 (ffebld_constant_character5 (c1),
+				       ffebld_constant_character5 (c2));
+#endif
+
+#if FFETARGET_okCHARACTER6
+    case FFEBLD_constCHARACTER6:
+      return ffetarget_cmp_character6 (ffebld_constant_character6 (c1),
+				       ffebld_constant_character6 (c2));
+#endif
+
+#if FFETARGET_okCHARACTER7
+    case FFEBLD_constCHARACTER7:
+      return ffetarget_cmp_character7 (ffebld_constant_character7 (c1),
+				       ffebld_constant_character7 (c2));
+#endif
+
+#if FFETARGET_okCHARACTER8
+    case FFEBLD_constCHARACTER8:
+      return ffetarget_cmp_character8 (ffebld_constant_character8 (c1),
+				       ffebld_constant_character8 (c2));
+#endif
+
+    default:
+      assert ("bad constant type" == NULL);
+      return 0;
+    }
+}
+
+/* ffebld_constant_dump -- Display summary of constant's contents
+
+   ffebldConstant c;
+   ffebld_constant_dump(c);
+
+   Displays the constant in summary form.  */
+
+void
+ffebld_constant_dump (ffebldConstant c)
+{
+  switch (ffebld_constant_type (c))
+    {
+#if FFETARGET_okINTEGER1
+    case FFEBLD_constINTEGER1:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER,
+			  FFEINFO_kindtypeINTEGER1);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER1);
+      break;
+#endif
+
+#if FFETARGET_okINTEGER2
+    case FFEBLD_constINTEGER2:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER,
+			  FFEINFO_kindtypeINTEGER2);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER2);
+      break;
+#endif
+
+#if FFETARGET_okINTEGER3
+    case FFEBLD_constINTEGER3:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER,
+			  FFEINFO_kindtypeINTEGER3);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER3);
+      break;
+#endif
+
+#if FFETARGET_okINTEGER4
+    case FFEBLD_constINTEGER4:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER,
+			  FFEINFO_kindtypeINTEGER4);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER4);
+      break;
+#endif
+
+#if FFETARGET_okINTEGER5
+    case FFEBLD_constINTEGER5:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER,
+			  FFEINFO_kindtypeINTEGER5);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER5);
+      break;
+#endif
+
+#if FFETARGET_okINTEGER6
+    case FFEBLD_constINTEGER6:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER,
+			  FFEINFO_kindtypeINTEGER6);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER6);
+      break;
+#endif
+
+#if FFETARGET_okINTEGER7
+    case FFEBLD_constINTEGER7:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER,
+			  FFEINFO_kindtypeINTEGER7);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER7);
+      break;
+#endif
+
+#if FFETARGET_okINTEGER8
+    case FFEBLD_constINTEGER8:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER,
+			  FFEINFO_kindtypeINTEGER8);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER8);
+      break;
+#endif
+
+#if FFETARGET_okLOGICAL1
+    case FFEBLD_constLOGICAL1:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL,
+			  FFEINFO_kindtypeLOGICAL1);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL1);
+      break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+    case FFEBLD_constLOGICAL2:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL,
+			  FFEINFO_kindtypeLOGICAL2);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL2);
+      break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+    case FFEBLD_constLOGICAL3:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL,
+			  FFEINFO_kindtypeLOGICAL3);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL3);
+      break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+    case FFEBLD_constLOGICAL4:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL,
+			  FFEINFO_kindtypeLOGICAL4);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL4);
+      break;
+#endif
+
+#if FFETARGET_okLOGICAL5
+    case FFEBLD_constLOGICAL5:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL,
+			  FFEINFO_kindtypeLOGICAL5);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL5);
+      break;
+#endif
+
+#if FFETARGET_okLOGICAL6
+    case FFEBLD_constLOGICAL6:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL,
+			  FFEINFO_kindtypeLOGICAL6);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL6);
+      break;
+#endif
+
+#if FFETARGET_okLOGICAL7
+    case FFEBLD_constLOGICAL7:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL,
+			  FFEINFO_kindtypeLOGICAL7);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL7);
+      break;
+#endif
+
+#if FFETARGET_okLOGICAL8
+    case FFEBLD_constLOGICAL8:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL,
+			  FFEINFO_kindtypeLOGICAL8);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL8);
+      break;
+#endif
+
+#if FFETARGET_okREAL1
+    case FFEBLD_constREAL1:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL,
+			  FFEINFO_kindtypeREAL1);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			      FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL1);
+      break;
+#endif
+
+#if FFETARGET_okREAL2
+    case FFEBLD_constREAL2:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL,
+			  FFEINFO_kindtypeREAL2);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			      FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL2);
+      break;
+#endif
+
+#if FFETARGET_okREAL3
+    case FFEBLD_constREAL3:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL,
+			  FFEINFO_kindtypeREAL3);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			      FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL3);
+      break;
+#endif
+
+#if FFETARGET_okREAL4
+    case FFEBLD_constREAL4:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL,
+			  FFEINFO_kindtypeREAL4);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			      FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL4);
+      break;
+#endif
+
+#if FFETARGET_okREAL5
+    case FFEBLD_constREAL5:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL,
+			  FFEINFO_kindtypeREAL5);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			      FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL5);
+      break;
+#endif
+
+#if FFETARGET_okREAL6
+    case FFEBLD_constREAL6:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL,
+			  FFEINFO_kindtypeREAL6);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			      FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL6);
+      break;
+#endif
+
+#if FFETARGET_okREAL7
+    case FFEBLD_constREAL7:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL,
+			  FFEINFO_kindtypeREAL7);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			      FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL7);
+      break;
+#endif
+
+#if FFETARGET_okREAL8
+    case FFEBLD_constREAL8:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL,
+			  FFEINFO_kindtypeREAL8);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			      FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL8);
+      break;
+#endif
+
+#if FFETARGET_okCOMPLEX1
+    case FFEBLD_constCOMPLEX1:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX,
+			  FFEINFO_kindtypeREAL1);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			   FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL1);
+      break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+    case FFEBLD_constCOMPLEX2:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX,
+			  FFEINFO_kindtypeREAL2);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			   FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL2);
+      break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+    case FFEBLD_constCOMPLEX3:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX,
+			  FFEINFO_kindtypeREAL3);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			   FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL3);
+      break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+    case FFEBLD_constCOMPLEX4:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX,
+			  FFEINFO_kindtypeREAL4);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			   FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL4);
+      break;
+#endif
+
+#if FFETARGET_okCOMPLEX5
+    case FFEBLD_constCOMPLEX5:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX,
+			  FFEINFO_kindtypeREAL5);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			   FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL5);
+      break;
+#endif
+
+#if FFETARGET_okCOMPLEX6
+    case FFEBLD_constCOMPLEX6:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX,
+			  FFEINFO_kindtypeREAL6);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			   FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL6);
+      break;
+#endif
+
+#if FFETARGET_okCOMPLEX7
+    case FFEBLD_constCOMPLEX7:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX,
+			  FFEINFO_kindtypeREAL7);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			   FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL7);
+      break;
+#endif
+
+#if FFETARGET_okCOMPLEX8
+    case FFEBLD_constCOMPLEX8:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX,
+			  FFEINFO_kindtypeREAL8);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+			   FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL8);
+      break;
+#endif
+
+#if FFETARGET_okCHARACTER1
+    case FFEBLD_constCHARACTER1:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER,
+			  FFEINFO_kindtypeCHARACTER1);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+		    FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER1);
+      break;
+#endif
+
+#if FFETARGET_okCHARACTER2
+    case FFEBLD_constCHARACTER2:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER,
+			  FFEINFO_kindtypeCHARACTER2);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+		    FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER2);
+      break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+    case FFEBLD_constCHARACTER3:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER,
+			  FFEINFO_kindtypeCHARACTER3);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+		    FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER3);
+      break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+    case FFEBLD_constCHARACTER4:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER,
+			  FFEINFO_kindtypeCHARACTER4);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+		    FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER4);
+      break;
+#endif
+
+#if FFETARGET_okCHARACTER5
+    case FFEBLD_constCHARACTER5:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER,
+			  FFEINFO_kindtypeCHARACTER5);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+		    FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER5);
+      break;
+#endif
+
+#if FFETARGET_okCHARACTER6
+    case FFEBLD_constCHARACTER6:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER,
+			  FFEINFO_kindtypeCHARACTER6);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+		    FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER6);
+      break;
+#endif
+
+#if FFETARGET_okCHARACTER7
+    case FFEBLD_constCHARACTER7:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER,
+			  FFEINFO_kindtypeCHARACTER7);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+		    FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER7);
+      break;
+#endif
+
+#if FFETARGET_okCHARACTER8
+    case FFEBLD_constCHARACTER8:
+      ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER,
+			  FFEINFO_kindtypeCHARACTER8);
+      ffebld_constantunion_dump (ffebld_constant_union (c),
+		    FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER8);
+      break;
+#endif
+
+    case FFEBLD_constHOLLERITH:
+      fprintf (dmpout, "H%" ffetargetHollerithSize_f "u/",
+	       ffebld_constant_hollerith (c).length);
+      ffetarget_print_hollerith (dmpout, ffebld_constant_hollerith (c));
+      break;
+
+    case FFEBLD_constBINARY_MIL:
+      fprintf (dmpout, "BM/");
+      ffetarget_print_binarymil (dmpout, ffebld_constant_typeless (c));
+      break;
+
+    case FFEBLD_constBINARY_VXT:
+      fprintf (dmpout, "BV/");
+      ffetarget_print_binaryvxt (dmpout, ffebld_constant_typeless (c));
+      break;
+
+    case FFEBLD_constOCTAL_MIL:
+      fprintf (dmpout, "OM/");
+      ffetarget_print_octalmil (dmpout, ffebld_constant_typeless (c));
+      break;
+
+    case FFEBLD_constOCTAL_VXT:
+      fprintf (dmpout, "OV/");
+      ffetarget_print_octalvxt (dmpout, ffebld_constant_typeless (c));
+      break;
+
+    case FFEBLD_constHEX_X_MIL:
+      fprintf (dmpout, "XM/");
+      ffetarget_print_hexxmil (dmpout, ffebld_constant_typeless (c));
+      break;
+
+    case FFEBLD_constHEX_X_VXT:
+      fprintf (dmpout, "XV/");
+      ffetarget_print_hexxvxt (dmpout, ffebld_constant_typeless (c));
+      break;
+
+    case FFEBLD_constHEX_Z_MIL:
+      fprintf (dmpout, "ZM/");
+      ffetarget_print_hexzmil (dmpout, ffebld_constant_typeless (c));
+      break;
+
+    case FFEBLD_constHEX_Z_VXT:
+      fprintf (dmpout, "ZV/");
+      ffetarget_print_hexzvxt (dmpout, ffebld_constant_typeless (c));
+      break;
+
+    default:
+      assert ("bad constant type" == NULL);
+      fprintf (dmpout, "?/?");
+      break;
+    }
+}
+
+/* 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_okINTEGER5
+    case FFEBLD_constINTEGER5:
+      return ffebld_constant_integer5 (c) == 0;
+#endif
+
+#if FFETARGET_okINTEGER6
+    case FFEBLD_constINTEGER6:
+      return ffebld_constant_integer6 (c) == 0;
+#endif
+
+#if FFETARGET_okINTEGER7
+    case FFEBLD_constINTEGER7:
+      return ffebld_constant_integer7 (c) == 0;
+#endif
+
+#if FFETARGET_okINTEGER8
+    case FFEBLD_constINTEGER8:
+      return ffebld_constant_integer8 (c) == 0;
+#endif
+
+#if FFETARGET_okLOGICAL1
+    case FFEBLD_constLOGICAL1:
+      return ffebld_constant_logical1 (c) == 0;
+#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_okLOGICAL5
+    case FFEBLD_constLOGICAL5:
+      return ffebld_constant_logical5 (c) == 0;
+#endif
+
+#if FFETARGET_okLOGICAL6
+    case FFEBLD_constLOGICAL6:
+      return ffebld_constant_logical6 (c) == 0;
+#endif
+
+#if FFETARGET_okLOGICAL7
+    case FFEBLD_constLOGICAL7:
+      return ffebld_constant_logical7 (c) == 0;
+#endif
+
+#if FFETARGET_okLOGICAL8
+    case FFEBLD_constLOGICAL8:
+      return ffebld_constant_logical8 (c) == 0;
+#endif
+
+#if FFETARGET_okREAL1
+    case FFEBLD_constREAL1:
+      return ffetarget_iszero_real1 (ffebld_constant_real1 (c));
+#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_okREAL4
+    case FFEBLD_constREAL4:
+      return ffetarget_iszero_real4 (ffebld_constant_real4 (c));
+#endif
+
+#if FFETARGET_okREAL5
+    case FFEBLD_constREAL5:
+      return ffetarget_iszero_real5 (ffebld_constant_real5 (c));
+#endif
+
+#if FFETARGET_okREAL6
+    case FFEBLD_constREAL6:
+      return ffetarget_iszero_real6 (ffebld_constant_real6 (c));
+#endif
+
+#if FFETARGET_okREAL7
+    case FFEBLD_constREAL7:
+      return ffetarget_iszero_real7 (ffebld_constant_real7 (c));
+#endif
+
+#if FFETARGET_okREAL8
+    case FFEBLD_constREAL8:
+      return ffetarget_iszero_real8 (ffebld_constant_real8 (c));
+#endif
+
+#if FFETARGET_okCOMPLEX1
+    case FFEBLD_constCOMPLEX1:
+      return ffetarget_iszero_real1 (ffebld_constant_complex1 (c).real)
+     && 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_okCOMPLEX4
+    case FFEBLD_constCOMPLEX4:
+      return ffetarget_iszero_real4 (ffebld_constant_complex4 (c).real)
+     && ffetarget_iszero_real4 (ffebld_constant_complex4 (c).imaginary);
+#endif
+
+#if FFETARGET_okCOMPLEX5
+    case FFEBLD_constCOMPLEX5:
+      return ffetarget_iszero_real5 (ffebld_constant_complex5 (c).real)
+     && ffetarget_iszero_real5 (ffebld_constant_complex5 (c).imaginary);
+#endif
+
+#if FFETARGET_okCOMPLEX6
+    case FFEBLD_constCOMPLEX6:
+      return ffetarget_iszero_real6 (ffebld_constant_complex6 (c).real)
+     && ffetarget_iszero_real6 (ffebld_constant_complex6 (c).imaginary);
+#endif
+
+#if FFETARGET_okCOMPLEX7
+    case FFEBLD_constCOMPLEX7:
+      return ffetarget_iszero_real7 (ffebld_constant_complex7 (c).real)
+     && ffetarget_iszero_real7 (ffebld_constant_complex7 (c).imaginary);
+#endif
+
+#if FFETARGET_okCOMPLEX8
+    case FFEBLD_constCOMPLEX8:
+      return ffetarget_iszero_real8 (ffebld_constant_complex8 (c).real)
+     && ffetarget_iszero_real8 (ffebld_constant_complex8 (c).imaginary);
+#endif
+
+#if FFETARGET_okCHARACTER1
+    case FFEBLD_constCHARACTER1:
+      return ffetarget_iszero_character1 (ffebld_constant_character1 (c));
+#endif
+
+#if FFETARGET_okCHARACTER2 || FFETARGET_okCHARACTER3  /* ... */
+#error "no support for these!!"
+#endif
+
+    case FFEBLD_constHOLLERITH:
+      return ffetarget_iszero_hollerith (ffebld_constant_hollerith (c));
+
+    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;
+#ifdef FFECOM_constantHOOK
+  nc->hook = FFECOM_constantNULL;
+#endif
+  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;
+#ifdef FFECOM_constantHOOK
+  nc->hook = FFECOM_constantNULL;
+#endif
+  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;
+#ifdef FFECOM_constantHOOK
+  nc->hook = FFECOM_constantNULL;
+#endif
+  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;
+#ifdef FFECOM_constantHOOK
+  nc->hook = FFECOM_constantNULL;
+#endif
+  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;
+#ifdef FFECOM_constantHOOK
+  nc->hook = FFECOM_constantNULL;
+#endif
+  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;
+#ifdef FFECOM_constantHOOK
+  nc->hook = FFECOM_constantNULL;
+#endif
+  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;
+#ifdef FFECOM_constantHOOK
+  nc->hook = FFECOM_constantNULL;
+#endif
+  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;
+#ifdef FFECOM_constantHOOK
+  nc->hook = FFECOM_constantNULL;
+#endif
+  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;
+#ifdef FFECOM_constantHOOK
+  nc->hook = FFECOM_constantNULL;
+#endif
+  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;
+#ifdef FFECOM_constantHOOK
+  nc->hook = FFECOM_constantNULL;
+#endif
+  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;
+#ifdef FFECOM_constantHOOK
+  nc->hook = FFECOM_constantNULL;
+#endif
+  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;
+#ifdef FFECOM_constantHOOK
+  nc->hook = FFECOM_constantNULL;
+#endif
+  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;
+#ifdef FFECOM_constantHOOK
+  nc->hook = FFECOM_constantNULL;
+#endif
+  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;
+#ifdef FFECOM_constantHOOK
+  nc->hook = FFECOM_constantNULL;
+#endif
+  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;
+#ifdef FFECOM_constantHOOK
+  nc->hook = FFECOM_constantNULL;
+#endif
+  c->next = nc;
+
+  return nc;
+}
+
+/* ffebld_constantarray_dump -- Display summary of array's contents
+
+   ffebldConstantArray a;
+   ffeinfoBasictype bt;
+   ffeinfoKindtype kt;
+   ffetargetOffset size;
+   ffebld_constant_dump(a,bt,kt,size,NULL);
+
+   Displays the constant array in summary form.	 The fifth argument, if
+   supplied, is an ffebit object that is consulted as to whether the
+   constant at a particular offset is valid.  */
+
+void
+ffebld_constantarray_dump (ffebldConstantArray array, ffeinfoBasictype bt,
+		      ffeinfoKindtype kt, ffetargetOffset size, ffebit bits)
+{
+  ffetargetOffset i;
+  ffebitCount j;
+
+  ffebld_dump_prefix (dmpout, bt, kt);
+
+  fprintf (dmpout, "\\(");
+
+  if (bits == NULL)
+    {
+      for (i = 0; i < size; ++i)
+	{
+	  ffebld_constantunion_dump (ffebld_constantarray_get (array, bt, kt, i), bt,
+				     kt);
+	  if (i != size - 1)
+	    fputc (',', dmpout);
+	}
+    }
+  else
+    {
+      bool value;
+      ffebitCount length;
+      ffetargetOffset offset = 0;
+
+      do
+	{
+	  ffebit_test (bits, offset, &value, &length);
+	  if (value && (length != 0))
+	    {
+	      if (length == 1)
+		fprintf (dmpout, "[%" ffetargetOffset_f "d]:", offset);
+	      else
+		fprintf (dmpout,
+		      "[%" ffetargetOffset_f "u..%" ffetargetOffset_f "d]:",
+			 offset, offset + (ffetargetOffset) length - 1);
+	      for (j = 0; j < length; ++j, ++offset)
+		{
+		  ffebld_constantunion_dump (ffebld_constantarray_get (array, bt, kt,
+							   offset), bt, kt);
+		  if (j != length - 1)
+		    fputc (',', dmpout);
+		}
+	      fprintf (dmpout, ";");
+	    }
+	  else
+	    offset += length;
+	}
+      while (length != 0);
+    }
+  fprintf (dmpout, "\\)");
+
+}
+
+/* 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
+
+#if FFETARGET_okINTEGER5
+	case FFEINFO_kindtypeINTEGER5:
+	  u.integer5 = *(array.integer5 + offset);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER6
+	case FFEINFO_kindtypeINTEGER6:
+	  u.integer6 = *(array.integer6 + offset);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER7
+	case FFEINFO_kindtypeINTEGER7:
+	  u.integer7 = *(array.integer7 + offset);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER8
+	case FFEINFO_kindtypeINTEGER8:
+	  u.integer8 = *(array.integer8 + offset);
+	  break;
+#endif
+
+	default:
+	  assert ("bad INTEGER kindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okLOGICAL5
+	case FFEINFO_kindtypeLOGICAL5:
+	  u.logical5 = *(array.logical5 + offset);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL6
+	case FFEINFO_kindtypeLOGICAL6:
+	  u.logical6 = *(array.logical6 + offset);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL7
+	case FFEINFO_kindtypeLOGICAL7:
+	  u.logical7 = *(array.logical7 + offset);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL8
+	case FFEINFO_kindtypeLOGICAL8:
+	  u.logical8 = *(array.logical8 + offset);
+	  break;
+#endif
+
+	default:
+	  assert ("bad LOGICAL kindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okREAL4
+	case FFEINFO_kindtypeREAL4:
+	  u.real4 = *(array.real4 + offset);
+	  break;
+#endif
+
+#if FFETARGET_okREAL5
+	case FFEINFO_kindtypeREAL5:
+	  u.real5 = *(array.real5 + offset);
+	  break;
+#endif
+
+#if FFETARGET_okREAL6
+	case FFEINFO_kindtypeREAL6:
+	  u.real6 = *(array.real6 + offset);
+	  break;
+#endif
+
+#if FFETARGET_okREAL7
+	case FFEINFO_kindtypeREAL7:
+	  u.real7 = *(array.real7 + offset);
+	  break;
+#endif
+
+#if FFETARGET_okREAL8
+	case FFEINFO_kindtypeREAL8:
+	  u.real8 = *(array.real8 + offset);
+	  break;
+#endif
+
+	default:
+	  assert ("bad REAL kindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okCOMPLEX4
+	case FFEINFO_kindtypeREAL4:
+	  u.complex4 = *(array.complex4 + offset);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX5
+	case FFEINFO_kindtypeREAL5:
+	  u.complex5 = *(array.complex5 + offset);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX6
+	case FFEINFO_kindtypeREAL6:
+	  u.complex6 = *(array.complex6 + offset);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX7
+	case FFEINFO_kindtypeREAL7:
+	  u.complex7 = *(array.complex7 + offset);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX8
+	case FFEINFO_kindtypeREAL8:
+	  u.complex8 = *(array.complex8 + offset);
+	  break;
+#endif
+
+	default:
+	  assert ("bad COMPLEX kindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCHARACTER:
+      switch (kt)
+	{
+#if FFETARGET_okCHARACTER1
+	case FFEINFO_kindtypeCHARACTER1:
+	  u.character1.length = 1;
+	  u.character1.text = array.character1 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER2
+	case FFEINFO_kindtypeCHARACTER2:
+	  u.character2.length = 1;
+	  u.character2.text = array.character2 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+	case FFEINFO_kindtypeCHARACTER3:
+	  u.character3.length = 1;
+	  u.character3.text = array.character3 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+	case FFEINFO_kindtypeCHARACTER4:
+	  u.character4.length = 1;
+	  u.character4.text = array.character4 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER5
+	case FFEINFO_kindtypeCHARACTER5:
+	  u.character5.length = 1;
+	  u.character5.text = array.character5 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER6
+	case FFEINFO_kindtypeCHARACTER6:
+	  u.character6.length = 1;
+	  u.character6.text = array.character6 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER7
+	case FFEINFO_kindtypeCHARACTER7:
+	  u.character7.length = 1;
+	  u.character7.text = array.character7 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER8
+	case FFEINFO_kindtypeCHARACTER8:
+	  u.character8.length = 1;
+	  u.character8.text = array.character8 + offset;
+	  break;
+#endif
+
+	default:
+	  assert ("bad CHARACTER kindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okINTEGER5
+	case FFEINFO_kindtypeINTEGER5:
+	  ptr.integer5 = malloc_new_zkp (ffebld_constant_pool(),
+					 "ffebldConstantArray",
+					 size *= sizeof (ffetargetInteger5),
+					 0);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER6
+	case FFEINFO_kindtypeINTEGER6:
+	  ptr.integer6 = malloc_new_zkp (ffebld_constant_pool(),
+					 "ffebldConstantArray",
+					 size *= sizeof (ffetargetInteger6),
+					 0);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER7
+	case FFEINFO_kindtypeINTEGER7:
+	  ptr.integer7 = malloc_new_zkp (ffebld_constant_pool(),
+					 "ffebldConstantArray",
+					 size *= sizeof (ffetargetInteger7),
+					 0);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER8
+	case FFEINFO_kindtypeINTEGER8:
+	  ptr.integer8 = malloc_new_zkp (ffebld_constant_pool(),
+					 "ffebldConstantArray",
+					 size *= sizeof (ffetargetInteger8),
+					 0);
+	  break;
+#endif
+
+	default:
+	  assert ("bad INTEGER kindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okLOGICAL5
+	case FFEINFO_kindtypeLOGICAL5:
+	  ptr.logical5 = malloc_new_zkp (ffebld_constant_pool(),
+					 "ffebldConstantArray",
+					 size *= sizeof (ffetargetLogical5),
+					 0);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL6
+	case FFEINFO_kindtypeLOGICAL6:
+	  ptr.logical6 = malloc_new_zkp (ffebld_constant_pool(),
+					 "ffebldConstantArray",
+					 size *= sizeof (ffetargetLogical6),
+					 0);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL7
+	case FFEINFO_kindtypeLOGICAL7:
+	  ptr.logical7 = malloc_new_zkp (ffebld_constant_pool(),
+					 "ffebldConstantArray",
+					 size *= sizeof (ffetargetLogical7),
+					 0);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL8
+	case FFEINFO_kindtypeLOGICAL8:
+	  ptr.logical8 = malloc_new_zkp (ffebld_constant_pool(),
+					 "ffebldConstantArray",
+					 size *= sizeof (ffetargetLogical8),
+					 0);
+	  break;
+#endif
+
+	default:
+	  assert ("bad LOGICAL kindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okREAL4
+	case FFEINFO_kindtypeREAL4:
+	  ptr.real4 = malloc_new_zkp (ffebld_constant_pool(),
+				      "ffebldConstantArray",
+				      size *= sizeof (ffetargetReal4),
+				      0);
+	  break;
+#endif
+
+#if FFETARGET_okREAL5
+	case FFEINFO_kindtypeREAL5:
+	  ptr.real5 = malloc_new_zkp (ffebld_constant_pool(),
+				      "ffebldConstantArray",
+				      size *= sizeof (ffetargetReal5),
+				      0);
+	  break;
+#endif
+
+#if FFETARGET_okREAL6
+	case FFEINFO_kindtypeREAL6:
+	  ptr.real6 = malloc_new_zkp (ffebld_constant_pool(),
+				      "ffebldConstantArray",
+				      size *= sizeof (ffetargetReal6),
+				      0);
+	  break;
+#endif
+
+#if FFETARGET_okREAL7
+	case FFEINFO_kindtypeREAL7:
+	  ptr.real7 = malloc_new_zkp (ffebld_constant_pool(),
+				      "ffebldConstantArray",
+				      size *= sizeof (ffetargetReal7),
+				      0);
+	  break;
+#endif
+
+#if FFETARGET_okREAL8
+	case FFEINFO_kindtypeREAL8:
+	  ptr.real8 = malloc_new_zkp (ffebld_constant_pool(),
+				      "ffebldConstantArray",
+				      size *= sizeof (ffetargetReal8),
+				      0);
+	  break;
+#endif
+
+	default:
+	  assert ("bad REAL kindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okCOMPLEX4
+	case FFEINFO_kindtypeREAL4:
+	  ptr.complex4 = malloc_new_zkp (ffebld_constant_pool(),
+					 "ffebldConstantArray",
+					 size *= sizeof (ffetargetComplex4),
+					 0);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX5
+	case FFEINFO_kindtypeREAL5:
+	  ptr.complex5 = malloc_new_zkp (ffebld_constant_pool(),
+					 "ffebldConstantArray",
+					 size *= sizeof (ffetargetComplex5),
+					 0);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX6
+	case FFEINFO_kindtypeREAL6:
+	  ptr.complex6 = malloc_new_zkp (ffebld_constant_pool(),
+					 "ffebldConstantArray",
+					 size *= sizeof (ffetargetComplex6),
+					 0);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX7
+	case FFEINFO_kindtypeREAL7:
+	  ptr.complex7 = malloc_new_zkp (ffebld_constant_pool(),
+					 "ffebldConstantArray",
+					 size *= sizeof (ffetargetComplex7),
+					 0);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX8
+	case FFEINFO_kindtypeREAL8:
+	  ptr.complex8 = malloc_new_zkp (ffebld_constant_pool(),
+					 "ffebldConstantArray",
+					 size *= sizeof (ffetargetComplex8),
+					 0);
+	  break;
+#endif
+
+	default:
+	  assert ("bad COMPLEX kindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okCHARACTER2
+	case FFEINFO_kindtypeCHARACTER2:
+	  ptr.character2 = malloc_new_zkp (ffebld_constant_pool(),
+					   "ffebldConstantArray",
+					   size
+					   *= sizeof (ffetargetCharacterUnit2),
+					   0);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+	case FFEINFO_kindtypeCHARACTER3:
+	  ptr.character3 = malloc_new_zkp (ffebld_constant_pool(),
+					   "ffebldConstantArray",
+					   size
+					   *= sizeof (ffetargetCharacterUnit3),
+					   0);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+	case FFEINFO_kindtypeCHARACTER4:
+	  ptr.character4 = malloc_new_zkp (ffebld_constant_pool(),
+					   "ffebldConstantArray",
+					   size
+					   *= sizeof (ffetargetCharacterUnit4),
+					   0);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER5
+	case FFEINFO_kindtypeCHARACTER5:
+	  ptr.character5 = malloc_new_zkp (ffebld_constant_pool(),
+					   "ffebldConstantArray",
+					   size
+					   *= sizeof (ffetargetCharacterUnit5),
+					   0);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER6
+	case FFEINFO_kindtypeCHARACTER6:
+	  ptr.character6 = malloc_new_zkp (ffebld_constant_pool(),
+					   "ffebldConstantArray",
+					   size
+					   *= sizeof (ffetargetCharacterUnit6),
+					   0);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER7
+	case FFEINFO_kindtypeCHARACTER7:
+	  ptr.character7 = malloc_new_zkp (ffebld_constant_pool(),
+					   "ffebldConstantArray",
+					   size
+					   *= sizeof (ffetargetCharacterUnit7),
+					   0);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER8
+	case FFEINFO_kindtypeCHARACTER8:
+	  ptr.character8 = malloc_new_zkp (ffebld_constant_pool(),
+					   "ffebldConstantArray",
+					   size
+					   *= sizeof (ffetargetCharacterUnit8),
+					   0);
+	  break;
+#endif
+
+	default:
+	  assert ("bad CHARACTER kindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okINTEGER5
+	case FFEINFO_kindtypeINTEGER5:
+	  *aptr = array.integer5 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER6
+	case FFEINFO_kindtypeINTEGER6:
+	  *aptr = array.integer6 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER7
+	case FFEINFO_kindtypeINTEGER7:
+	  *aptr = array.integer7 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER8
+	case FFEINFO_kindtypeINTEGER8:
+	  *aptr = array.integer8 + offset;
+	  break;
+#endif
+
+	default:
+	  assert ("bad INTEGER akindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okLOGICAL5
+	case FFEINFO_kindtypeLOGICAL5:
+	  *aptr = array.logical5 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL6
+	case FFEINFO_kindtypeLOGICAL6:
+	  *aptr = array.logical6 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL7
+	case FFEINFO_kindtypeLOGICAL7:
+	  *aptr = array.logical7 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL8
+	case FFEINFO_kindtypeLOGICAL8:
+	  *aptr = array.logical8 + offset;
+	  break;
+#endif
+
+	default:
+	  assert ("bad LOGICAL akindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okREAL4
+	case FFEINFO_kindtypeREAL4:
+	  *aptr = array.real4 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okREAL5
+	case FFEINFO_kindtypeREAL5:
+	  *aptr = array.real5 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okREAL6
+	case FFEINFO_kindtypeREAL6:
+	  *aptr = array.real6 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okREAL7
+	case FFEINFO_kindtypeREAL7:
+	  *aptr = array.real7 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okREAL8
+	case FFEINFO_kindtypeREAL8:
+	  *aptr = array.real8 + offset;
+	  break;
+#endif
+
+	default:
+	  assert ("bad REAL akindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okCOMPLEX4
+	case FFEINFO_kindtypeREAL4:
+	  *aptr = array.complex4 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX5
+	case FFEINFO_kindtypeREAL5:
+	  *aptr = array.complex5 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX6
+	case FFEINFO_kindtypeREAL6:
+	  *aptr = array.complex6 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX7
+	case FFEINFO_kindtypeREAL7:
+	  *aptr = array.complex7 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX8
+	case FFEINFO_kindtypeREAL8:
+	  *aptr = array.complex8 + offset;
+	  break;
+#endif
+
+	default:
+	  assert ("bad COMPLEX akindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCHARACTER:
+      switch (akt)
+	{
+#if FFETARGET_okCHARACTER1
+	case FFEINFO_kindtypeCHARACTER1:
+	  *aptr = array.character1 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER2
+	case FFEINFO_kindtypeCHARACTER2:
+	  *aptr = array.character2 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+	case FFEINFO_kindtypeCHARACTER3:
+	  *aptr = array.character3 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+	case FFEINFO_kindtypeCHARACTER4:
+	  *aptr = array.character4 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER5
+	case FFEINFO_kindtypeCHARACTER5:
+	  *aptr = array.character5 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER6
+	case FFEINFO_kindtypeCHARACTER6:
+	  *aptr = array.character6 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER7
+	case FFEINFO_kindtypeCHARACTER7:
+	  *aptr = array.character7 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER8
+	case FFEINFO_kindtypeCHARACTER8:
+	  *aptr = array.character8 + offset;
+	  break;
+#endif
+
+	default:
+	  assert ("bad CHARACTER akindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okINTEGER5
+	case FFEINFO_kindtypeINTEGER5:
+	  *cptr = source_array.integer5;
+	  *size = sizeof (*source_array.integer5);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER6
+	case FFEINFO_kindtypeINTEGER6:
+	  *cptr = source_array.integer6;
+	  *size = sizeof (*source_array.integer6);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER7
+	case FFEINFO_kindtypeINTEGER7:
+	  *cptr = source_array.integer7;
+	  *size = sizeof (*source_array.integer7);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER8
+	case FFEINFO_kindtypeINTEGER8:
+	  *cptr = source_array.integer8;
+	  *size = sizeof (*source_array.integer8);
+	  break;
+#endif
+
+	default:
+	  assert ("bad INTEGER ckindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okLOGICAL5
+	case FFEINFO_kindtypeLOGICAL5:
+	  *cptr = source_array.logical5;
+	  *size = sizeof (*source_array.logical5);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL6
+	case FFEINFO_kindtypeLOGICAL6:
+	  *cptr = source_array.logical6;
+	  *size = sizeof (*source_array.logical6);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL7
+	case FFEINFO_kindtypeLOGICAL7:
+	  *cptr = source_array.logical7;
+	  *size = sizeof (*source_array.logical7);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL8
+	case FFEINFO_kindtypeLOGICAL8:
+	  *cptr = source_array.logical8;
+	  *size = sizeof (*source_array.logical8);
+	  break;
+#endif
+
+	default:
+	  assert ("bad LOGICAL ckindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okREAL4
+	case FFEINFO_kindtypeREAL4:
+	  *cptr = source_array.real4;
+	  *size = sizeof (*source_array.real4);
+	  break;
+#endif
+
+#if FFETARGET_okREAL5
+	case FFEINFO_kindtypeREAL5:
+	  *cptr = source_array.real5;
+	  *size = sizeof (*source_array.real5);
+	  break;
+#endif
+
+#if FFETARGET_okREAL6
+	case FFEINFO_kindtypeREAL6:
+	  *cptr = source_array.real6;
+	  *size = sizeof (*source_array.real6);
+	  break;
+#endif
+
+#if FFETARGET_okREAL7
+	case FFEINFO_kindtypeREAL7:
+	  *cptr = source_array.real7;
+	  *size = sizeof (*source_array.real7);
+	  break;
+#endif
+
+#if FFETARGET_okREAL8
+	case FFEINFO_kindtypeREAL8:
+	  *cptr = source_array.real8;
+	  *size = sizeof (*source_array.real8);
+	  break;
+#endif
+
+	default:
+	  assert ("bad REAL ckindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okCOMPLEX4
+	case FFEINFO_kindtypeREAL4:
+	  *cptr = source_array.complex4;
+	  *size = sizeof (*source_array.complex4);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX5
+	case FFEINFO_kindtypeREAL5:
+	  *cptr = source_array.complex5;
+	  *size = sizeof (*source_array.complex5);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX6
+	case FFEINFO_kindtypeREAL6:
+	  *cptr = source_array.complex6;
+	  *size = sizeof (*source_array.complex6);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX7
+	case FFEINFO_kindtypeREAL7:
+	  *cptr = source_array.complex7;
+	  *size = sizeof (*source_array.complex7);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX8
+	case FFEINFO_kindtypeREAL8:
+	  *cptr = source_array.complex8;
+	  *size = sizeof (*source_array.complex8);
+	  break;
+#endif
+
+	default:
+	  assert ("bad COMPLEX ckindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCHARACTER:
+      switch (ckt)
+	{
+#if FFETARGET_okCHARACTER1
+	case FFEINFO_kindtypeCHARACTER1:
+	  *cptr = source_array.character1;
+	  *size = sizeof (*source_array.character1);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER2
+	case FFEINFO_kindtypeCHARACTER2:
+	  *cptr = source_array.character2;
+	  *size = sizeof (*source_array.character2);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+	case FFEINFO_kindtypeCHARACTER3:
+	  *cptr = source_array.character3;
+	  *size = sizeof (*source_array.character3);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+	case FFEINFO_kindtypeCHARACTER4:
+	  *cptr = source_array.character4;
+	  *size = sizeof (*source_array.character4);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER5
+	case FFEINFO_kindtypeCHARACTER5:
+	  *cptr = source_array.character5;
+	  *size = sizeof (*source_array.character5);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER6
+	case FFEINFO_kindtypeCHARACTER6:
+	  *cptr = source_array.character6;
+	  *size = sizeof (*source_array.character6);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER7
+	case FFEINFO_kindtypeCHARACTER7:
+	  *cptr = source_array.character7;
+	  *size = sizeof (*source_array.character7);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER8
+	case FFEINFO_kindtypeCHARACTER8:
+	  *cptr = source_array.character8;
+	  *size = sizeof (*source_array.character8);
+	  break;
+#endif
+
+	default:
+	  assert ("bad CHARACTER ckindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okINTEGER5
+	case FFEINFO_kindtypeINTEGER5:
+	  *aptr = array.integer5 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER6
+	case FFEINFO_kindtypeINTEGER6:
+	  *aptr = array.integer6 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER7
+	case FFEINFO_kindtypeINTEGER7:
+	  *aptr = array.integer7 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER8
+	case FFEINFO_kindtypeINTEGER8:
+	  *aptr = array.integer8 + offset;
+	  break;
+#endif
+
+	default:
+	  assert ("bad INTEGER akindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okLOGICAL5
+	case FFEINFO_kindtypeLOGICAL5:
+	  *aptr = array.logical5 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL6
+	case FFEINFO_kindtypeLOGICAL6:
+	  *aptr = array.logical6 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL7
+	case FFEINFO_kindtypeLOGICAL7:
+	  *aptr = array.logical7 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL8
+	case FFEINFO_kindtypeLOGICAL8:
+	  *aptr = array.logical8 + offset;
+	  break;
+#endif
+
+	default:
+	  assert ("bad LOGICAL akindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okREAL4
+	case FFEINFO_kindtypeREAL4:
+	  *aptr = array.real4 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okREAL5
+	case FFEINFO_kindtypeREAL5:
+	  *aptr = array.real5 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okREAL6
+	case FFEINFO_kindtypeREAL6:
+	  *aptr = array.real6 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okREAL7
+	case FFEINFO_kindtypeREAL7:
+	  *aptr = array.real7 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okREAL8
+	case FFEINFO_kindtypeREAL8:
+	  *aptr = array.real8 + offset;
+	  break;
+#endif
+
+	default:
+	  assert ("bad REAL akindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okCOMPLEX4
+	case FFEINFO_kindtypeREAL4:
+	  *aptr = array.complex4 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX5
+	case FFEINFO_kindtypeREAL5:
+	  *aptr = array.complex5 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX6
+	case FFEINFO_kindtypeREAL6:
+	  *aptr = array.complex6 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX7
+	case FFEINFO_kindtypeREAL7:
+	  *aptr = array.complex7 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX8
+	case FFEINFO_kindtypeREAL8:
+	  *aptr = array.complex8 + offset;
+	  break;
+#endif
+
+	default:
+	  assert ("bad COMPLEX akindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCHARACTER:
+      switch (akt)
+	{
+#if FFETARGET_okCHARACTER1
+	case FFEINFO_kindtypeCHARACTER1:
+	  *aptr = array.character1 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER2
+	case FFEINFO_kindtypeCHARACTER2:
+	  *aptr = array.character2 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+	case FFEINFO_kindtypeCHARACTER3:
+	  *aptr = array.character3 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+	case FFEINFO_kindtypeCHARACTER4:
+	  *aptr = array.character4 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER5
+	case FFEINFO_kindtypeCHARACTER5:
+	  *aptr = array.character5 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER6
+	case FFEINFO_kindtypeCHARACTER6:
+	  *aptr = array.character6 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER7
+	case FFEINFO_kindtypeCHARACTER7:
+	  *aptr = array.character7 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER8
+	case FFEINFO_kindtypeCHARACTER8:
+	  *aptr = array.character8 + offset;
+	  break;
+#endif
+
+	default:
+	  assert ("bad CHARACTER akindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okINTEGER5
+	case FFEINFO_kindtypeINTEGER5:
+	  *cptr = &constant->integer5;
+	  *size = sizeof (constant->integer5);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER6
+	case FFEINFO_kindtypeINTEGER6:
+	  *cptr = &constant->integer6;
+	  *size = sizeof (constant->integer6);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER7
+	case FFEINFO_kindtypeINTEGER7:
+	  *cptr = &constant->integer7;
+	  *size = sizeof (constant->integer7);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER8
+	case FFEINFO_kindtypeINTEGER8:
+	  *cptr = &constant->integer8;
+	  *size = sizeof (constant->integer8);
+	  break;
+#endif
+
+	default:
+	  assert ("bad INTEGER ckindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okLOGICAL5
+	case FFEINFO_kindtypeLOGICAL5:
+	  *cptr = &constant->logical5;
+	  *size = sizeof (constant->logical5);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL6
+	case FFEINFO_kindtypeLOGICAL6:
+	  *cptr = &constant->logical6;
+	  *size = sizeof (constant->logical6);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL7
+	case FFEINFO_kindtypeLOGICAL7:
+	  *cptr = &constant->logical7;
+	  *size = sizeof (constant->logical7);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL8
+	case FFEINFO_kindtypeLOGICAL8:
+	  *cptr = &constant->logical8;
+	  *size = sizeof (constant->logical8);
+	  break;
+#endif
+
+	default:
+	  assert ("bad LOGICAL ckindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okREAL4
+	case FFEINFO_kindtypeREAL4:
+	  *cptr = &constant->real4;
+	  *size = sizeof (constant->real4);
+	  break;
+#endif
+
+#if FFETARGET_okREAL5
+	case FFEINFO_kindtypeREAL5:
+	  *cptr = &constant->real5;
+	  *size = sizeof (constant->real5);
+	  break;
+#endif
+
+#if FFETARGET_okREAL6
+	case FFEINFO_kindtypeREAL6:
+	  *cptr = &constant->real6;
+	  *size = sizeof (constant->real6);
+	  break;
+#endif
+
+#if FFETARGET_okREAL7
+	case FFEINFO_kindtypeREAL7:
+	  *cptr = &constant->real7;
+	  *size = sizeof (constant->real7);
+	  break;
+#endif
+
+#if FFETARGET_okREAL8
+	case FFEINFO_kindtypeREAL8:
+	  *cptr = &constant->real8;
+	  *size = sizeof (constant->real8);
+	  break;
+#endif
+
+	default:
+	  assert ("bad REAL ckindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okCOMPLEX4
+	case FFEINFO_kindtypeREAL4:
+	  *cptr = &constant->complex4;
+	  *size = sizeof (constant->complex4);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX5
+	case FFEINFO_kindtypeREAL5:
+	  *cptr = &constant->complex5;
+	  *size = sizeof (constant->complex5);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX6
+	case FFEINFO_kindtypeREAL6:
+	  *cptr = &constant->complex6;
+	  *size = sizeof (constant->complex6);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX7
+	case FFEINFO_kindtypeREAL7:
+	  *cptr = &constant->complex7;
+	  *size = sizeof (constant->complex7);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX8
+	case FFEINFO_kindtypeREAL8:
+	  *cptr = &constant->complex8;
+	  *size = sizeof (constant->complex8);
+	  break;
+#endif
+
+	default:
+	  assert ("bad COMPLEX ckindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okCHARACTER2
+	case FFEINFO_kindtypeCHARACTER2:
+	  *cptr = ffetarget_text_character2 (constant->character2);
+	  *size = ffetarget_length_character2 (constant->character2);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+	case FFEINFO_kindtypeCHARACTER3:
+	  *cptr = ffetarget_text_character3 (constant->character3);
+	  *size = ffetarget_length_character3 (constant->character3);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+	case FFEINFO_kindtypeCHARACTER4:
+	  *cptr = ffetarget_text_character4 (constant->character4);
+	  *size = ffetarget_length_character4 (constant->character4);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER5
+	case FFEINFO_kindtypeCHARACTER5:
+	  *cptr = ffetarget_text_character5 (constant->character5);
+	  *size = ffetarget_length_character5 (constant->character5);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER6
+	case FFEINFO_kindtypeCHARACTER6:
+	  *cptr = ffetarget_text_character6 (constant->character6);
+	  *size = ffetarget_length_character6 (constant->character6);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER7
+	case FFEINFO_kindtypeCHARACTER7:
+	  *cptr = ffetarget_text_character7 (constant->character7);
+	  *size = ffetarget_length_character7 (constant->character7);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER8
+	case FFEINFO_kindtypeCHARACTER8:
+	  *cptr = ffetarget_text_character8 (constant->character8);
+	  *size = ffetarget_length_character8 (constant->character8);
+	  break;
+#endif
+
+	default:
+	  assert ("bad CHARACTER ckindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okINTEGER5
+	case FFEINFO_kindtypeINTEGER5:
+	  *(array.integer5 + offset) = constant.integer5;
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER6
+	case FFEINFO_kindtypeINTEGER6:
+	  *(array.integer6 + offset) = constant.integer6;
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER7
+	case FFEINFO_kindtypeINTEGER7:
+	  *(array.integer7 + offset) = constant.integer7;
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER8
+	case FFEINFO_kindtypeINTEGER8:
+	  *(array.integer8 + offset) = constant.integer8;
+	  break;
+#endif
+
+	default:
+	  assert ("bad INTEGER kindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okLOGICAL5
+	case FFEINFO_kindtypeLOGICAL5:
+	  *(array.logical5 + offset) = constant.logical5;
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL6
+	case FFEINFO_kindtypeLOGICAL6:
+	  *(array.logical6 + offset) = constant.logical6;
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL7
+	case FFEINFO_kindtypeLOGICAL7:
+	  *(array.logical7 + offset) = constant.logical7;
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL8
+	case FFEINFO_kindtypeLOGICAL8:
+	  *(array.logical8 + offset) = constant.logical8;
+	  break;
+#endif
+
+	default:
+	  assert ("bad LOGICAL kindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okREAL4
+	case FFEINFO_kindtypeREAL4:
+	  *(array.real4 + offset) = constant.real4;
+	  break;
+#endif
+
+#if FFETARGET_okREAL5
+	case FFEINFO_kindtypeREAL5:
+	  *(array.real5 + offset) = constant.real5;
+	  break;
+#endif
+
+#if FFETARGET_okREAL6
+	case FFEINFO_kindtypeREAL6:
+	  *(array.real6 + offset) = constant.real6;
+	  break;
+#endif
+
+#if FFETARGET_okREAL7
+	case FFEINFO_kindtypeREAL7:
+	  *(array.real7 + offset) = constant.real7;
+	  break;
+#endif
+
+#if FFETARGET_okREAL8
+	case FFEINFO_kindtypeREAL8:
+	  *(array.real8 + offset) = constant.real8;
+	  break;
+#endif
+
+	default:
+	  assert ("bad REAL kindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okCOMPLEX4
+	case FFEINFO_kindtypeREAL4:
+	  *(array.complex4 + offset) = constant.complex4;
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX5
+	case FFEINFO_kindtypeREAL5:
+	  *(array.complex5 + offset) = constant.complex5;
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX6
+	case FFEINFO_kindtypeREAL6:
+	  *(array.complex6 + offset) = constant.complex6;
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX7
+	case FFEINFO_kindtypeREAL7:
+	  *(array.complex7 + offset) = constant.complex7;
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX8
+	case FFEINFO_kindtypeREAL8:
+	  *(array.complex8 + offset) = constant.complex8;
+	  break;
+#endif
+
+	default:
+	  assert ("bad COMPLEX kindtype" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okCHARACTER2
+	case FFEINFO_kindtypeCHARACTER2:
+	  memcpy (array.character2 + offset,
+		  ffetarget_text_character2 (constant.character2),
+		  ffetarget_length_character2 (constant.character2));
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+	case FFEINFO_kindtypeCHARACTER3:
+	  memcpy (array.character3 + offset,
+		  ffetarget_text_character3 (constant.character3),
+		  ffetarget_length_character3 (constant.character3));
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+	case FFEINFO_kindtypeCHARACTER4:
+	  memcpy (array.character4 + offset,
+		  ffetarget_text_character4 (constant.character4),
+		  ffetarget_length_character4 (constant.character4));
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER5
+	case FFEINFO_kindtypeCHARACTER5:
+	  memcpy (array.character5 + offset,
+		  ffetarget_text_character5 (constant.character5),
+		  ffetarget_length_character5 (constant.character5));
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER6
+	case FFEINFO_kindtypeCHARACTER6:
+	  memcpy (array.character6 + offset,
+		  ffetarget_text_character6 (constant.character6),
+		  ffetarget_length_character6 (constant.character6));
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER7
+	case FFEINFO_kindtypeCHARACTER7:
+	  memcpy (array.character7 + offset,
+		  ffetarget_text_character7 (constant.character7),
+		  ffetarget_length_character7 (constant.character7));
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER8
+	case FFEINFO_kindtypeCHARACTER8:
+	  memcpy (array.character8 + offset,
+		  ffetarget_text_character8 (constant.character8),
+		  ffetarget_length_character8 (constant.character8));
+	  break;
+#endif
+
+	default:
+	  assert ("bad CHARACTER kindtype" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad basictype" == NULL);
+      break;
+    }
+}
+
+/* ffebld_constantunion_dump -- Dump a constant
+
+   See prototype.  */
+
+void
+ffebld_constantunion_dump (ffebldConstantUnion u, ffeinfoBasictype bt,
+			   ffeinfoKindtype kt)
+{
+  switch (bt)
+    {
+    case FFEINFO_basictypeINTEGER:
+      switch (kt)
+	{
+#if FFETARGET_okINTEGER1
+	case FFEINFO_kindtypeINTEGER1:
+	  ffetarget_print_integer1 (dmpout, u.integer1);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	case FFEINFO_kindtypeINTEGER2:
+	  ffetarget_print_integer2 (dmpout, u.integer2);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	case FFEINFO_kindtypeINTEGER3:
+	  ffetarget_print_integer3 (dmpout, u.integer3);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	case FFEINFO_kindtypeINTEGER4:
+	  ffetarget_print_integer4 (dmpout, u.integer4);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER5
+	case FFEINFO_kindtypeINTEGER5:
+	  ffetarget_print_integer5 (dmpout, u.integer5);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER6
+	case FFEINFO_kindtypeINTEGER6:
+	  ffetarget_print_integer6 (dmpout, u.integer6);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER7
+	case FFEINFO_kindtypeINTEGER7:
+	  ffetarget_print_integer7 (dmpout, u.integer7);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER8
+	case FFEINFO_kindtypeINTEGER8:
+	  ffetarget_print_integer8 (dmpout, u.integer8);
+	  break;
+#endif
+
+	default:
+	  assert ("bad INTEGER kindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeLOGICAL:
+      switch (kt)
+	{
+#if FFETARGET_okLOGICAL1
+	case FFEINFO_kindtypeLOGICAL1:
+	  ffetarget_print_logical1 (dmpout, u.logical1);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+	case FFEINFO_kindtypeLOGICAL2:
+	  ffetarget_print_logical2 (dmpout, u.logical2);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+	case FFEINFO_kindtypeLOGICAL3:
+	  ffetarget_print_logical3 (dmpout, u.logical3);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+	case FFEINFO_kindtypeLOGICAL4:
+	  ffetarget_print_logical4 (dmpout, u.logical4);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL5
+	case FFEINFO_kindtypeLOGICAL5:
+	  ffetarget_print_logical5 (dmpout, u.logical5);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL6
+	case FFEINFO_kindtypeLOGICAL6:
+	  ffetarget_print_logical6 (dmpout, u.logical6);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL7
+	case FFEINFO_kindtypeLOGICAL7:
+	  ffetarget_print_logical7 (dmpout, u.logical7);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL8
+	case FFEINFO_kindtypeLOGICAL8:
+	  ffetarget_print_logical8 (dmpout, u.logical8);
+	  break;
+#endif
+
+	default:
+	  assert ("bad LOGICAL kindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeREAL:
+      switch (kt)
+	{
+#if FFETARGET_okREAL1
+	case FFEINFO_kindtypeREAL1:
+	  ffetarget_print_real1 (dmpout, u.real1);
+	  break;
+#endif
+
+#if FFETARGET_okREAL2
+	case FFEINFO_kindtypeREAL2:
+	  ffetarget_print_real2 (dmpout, u.real2);
+	  break;
+#endif
+
+#if FFETARGET_okREAL3
+	case FFEINFO_kindtypeREAL3:
+	  ffetarget_print_real3 (dmpout, u.real3);
+	  break;
+#endif
+
+#if FFETARGET_okREAL4
+	case FFEINFO_kindtypeREAL4:
+	  ffetarget_print_real4 (dmpout, u.real4);
+	  break;
+#endif
+
+#if FFETARGET_okREAL5
+	case FFEINFO_kindtypeREAL5:
+	  ffetarget_print_real5 (dmpout, u.real5);
+	  break;
+#endif
+
+#if FFETARGET_okREAL6
+	case FFEINFO_kindtypeREAL6:
+	  ffetarget_print_real6 (dmpout, u.real6);
+	  break;
+#endif
+
+#if FFETARGET_okREAL7
+	case FFEINFO_kindtypeREAL7:
+	  ffetarget_print_real7 (dmpout, u.real7);
+	  break;
+#endif
+
+#if FFETARGET_okREAL8
+	case FFEINFO_kindtypeREAL8:
+	  ffetarget_print_real8 (dmpout, u.real8);
+	  break;
+#endif
+
+	default:
+	  assert ("bad REAL kindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCOMPLEX:
+      switch (kt)
+	{
+#if FFETARGET_okCOMPLEX1
+	case FFEINFO_kindtypeREAL1:
+	  fprintf (dmpout, "(");
+	  ffetarget_print_real1 (dmpout, u.complex1.real);
+	  fprintf (dmpout, ",");
+	  ffetarget_print_real1 (dmpout, u.complex1.imaginary);
+	  fprintf (dmpout, ")");
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+	case FFEINFO_kindtypeREAL2:
+	  fprintf (dmpout, "(");
+	  ffetarget_print_real2 (dmpout, u.complex2.real);
+	  fprintf (dmpout, ",");
+	  ffetarget_print_real2 (dmpout, u.complex2.imaginary);
+	  fprintf (dmpout, ")");
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+	case FFEINFO_kindtypeREAL3:
+	  fprintf (dmpout, "(");
+	  ffetarget_print_real3 (dmpout, u.complex3.real);
+	  fprintf (dmpout, ",");
+	  ffetarget_print_real3 (dmpout, u.complex3.imaginary);
+	  fprintf (dmpout, ")");
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+	case FFEINFO_kindtypeREAL4:
+	  fprintf (dmpout, "(");
+	  ffetarget_print_real4 (dmpout, u.complex4.real);
+	  fprintf (dmpout, ",");
+	  ffetarget_print_real4 (dmpout, u.complex4.imaginary);
+	  fprintf (dmpout, ")");
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX5
+	case FFEINFO_kindtypeREAL5:
+	  fprintf (dmpout, "(");
+	  ffetarget_print_real5 (dmpout, u.complex5.real);
+	  fprintf (dmpout, ",");
+	  ffetarget_print_real5 (dmpout, u.complex5.imaginary);
+	  fprintf (dmpout, ")");
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX6
+	case FFEINFO_kindtypeREAL6:
+	  fprintf (dmpout, "(");
+	  ffetarget_print_real6 (dmpout, u.complex6.real);
+	  fprintf (dmpout, ",");
+	  ffetarget_print_real6 (dmpout, u.complex6.imaginary);
+	  fprintf (dmpout, ")");
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX7
+	case FFEINFO_kindtypeREAL7:
+	  fprintf (dmpout, "(");
+	  ffetarget_print_real7 (dmpout, u.complex7.real);
+	  fprintf (dmpout, ",");
+	  ffetarget_print_real7 (dmpout, u.complex7.imaginary);
+	  fprintf (dmpout, ")");
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX8
+	case FFEINFO_kindtypeREAL8:
+	  fprintf (dmpout, "(");
+	  ffetarget_print_real8 (dmpout, u.complex8.real);
+	  fprintf (dmpout, ",");
+	  ffetarget_print_real8 (dmpout, u.complex8.imaginary);
+	  fprintf (dmpout, ")");
+	  break;
+#endif
+
+	default:
+	  assert ("bad COMPLEX kindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCHARACTER:
+      switch (kt)
+	{
+#if FFETARGET_okCHARACTER1
+	case FFEINFO_kindtypeCHARACTER1:
+	  ffetarget_print_character1 (dmpout, u.character1);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER2
+	case FFEINFO_kindtypeCHARACTER2:
+	  ffetarget_print_character2 (dmpout, u.character2);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+	case FFEINFO_kindtypeCHARACTER3:
+	  ffetarget_print_character3 (dmpout, u.character3);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+	case FFEINFO_kindtypeCHARACTER4:
+	  ffetarget_print_character4 (dmpout, u.character4);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER5
+	case FFEINFO_kindtypeCHARACTER5:
+	  ffetarget_print_character5 (dmpout, u.character5);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER6
+	case FFEINFO_kindtypeCHARACTER6:
+	  ffetarget_print_character6 (dmpout, u.character6);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER7
+	case FFEINFO_kindtypeCHARACTER7:
+	  ffetarget_print_character7 (dmpout, u.character7);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER8
+	case FFEINFO_kindtypeCHARACTER8:
+	  ffetarget_print_character8 (dmpout, u.character8);
+	  break;
+#endif
+
+	default:
+	  assert ("bad CHARACTER kindtype" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad basictype" == NULL);
+      break;
+    }
+}
+
+/* ffebld_dump -- Dump expression tree in concise form
+
+   ffebld b;
+   ffebld_dump(b);  */
+
+void
+ffebld_dump (ffebld b)
+{
+  ffeinfoKind k;
+  ffeinfoWhere w;
+
+  if (b == NULL)
+    {
+      fprintf (dmpout, "(null)");
+      return;
+    }
+
+  switch (ffebld_op (b))
+    {
+    case FFEBLD_opITEM:
+      fputs ("[", dmpout);
+      while (b != NULL)
+	{
+	  ffebld_dump (ffebld_head (b));
+	  if ((b = ffebld_trail (b)) != NULL)
+	    fputs (",", dmpout);
+	}
+      fputs ("]", dmpout);
+      return;
+
+    case FFEBLD_opSTAR:
+    case FFEBLD_opBOUNDS:
+    case FFEBLD_opREPEAT:
+    case FFEBLD_opLABTER:
+    case FFEBLD_opLABTOK:
+    case FFEBLD_opIMPDO:
+      fputs (ffebld_op_string (ffebld_op (b)), dmpout);
+      break;
+
+    default:
+      if (ffeinfo_size (ffebld_info (b)) != FFETARGET_charactersizeNONE)
+	fprintf (dmpout, "%s%d%s%s*%" ffetargetCharacterSize_f "u",
+		 ffebld_op_string (ffebld_op (b)),
+		 (int) ffeinfo_rank (ffebld_info (b)),
+	     ffeinfo_basictype_string (ffeinfo_basictype (ffebld_info (b))),
+	       ffeinfo_kindtype_string (ffeinfo_kindtype (ffebld_info (b))),
+		 ffeinfo_size (ffebld_info (b)));
+      else
+	fprintf (dmpout, "%s%d%s%s", ffebld_op_string (ffebld_op (b)),
+		 (int) ffeinfo_rank (ffebld_info (b)),
+	     ffeinfo_basictype_string (ffeinfo_basictype (ffebld_info (b))),
+	      ffeinfo_kindtype_string (ffeinfo_kindtype (ffebld_info (b))));
+      if ((k = ffeinfo_kind (ffebld_info (b))) != FFEINFO_kindNONE)
+	fprintf (dmpout, "/%s", ffeinfo_kind_string (k));
+      if ((w = ffeinfo_where (ffebld_info (b))) != FFEINFO_whereNONE)
+	fprintf (dmpout, "@%s", ffeinfo_where_string (w));
+      break;
+    }
+
+  switch (ffebld_arity (b))
+    {
+    case 2:
+      fputs ("(", dmpout);
+      ffebld_dump (ffebld_left (b));
+      fputs (",", dmpout);
+      ffebld_dump (ffebld_right (b));
+      fputs (")", dmpout);
+      break;
+
+    case 1:
+      fputs ("(", dmpout);
+      ffebld_dump (ffebld_left (b));
+      fputs (")", dmpout);
+      break;
+
+    default:
+      switch (ffebld_op (b))
+	{
+	case FFEBLD_opCONTER:
+	  fprintf (dmpout, "<");
+	  ffebld_constant_dump (b->u.conter.expr);
+	  fprintf (dmpout, ">");
+	  break;
+
+	case FFEBLD_opACCTER:
+	  fprintf (dmpout, "<");
+	  ffebld_constantarray_dump (b->u.accter.array,
+				     ffeinfo_basictype (ffebld_info (b)),
+				     ffeinfo_kindtype (ffebld_info (b)),
+			  ffebit_size (b->u.accter.bits), b->u.accter.bits);
+	  fprintf (dmpout, ">");
+	  break;
+
+	case FFEBLD_opARRTER:
+	  fprintf (dmpout, "<");
+	  ffebld_constantarray_dump (b->u.arrter.array,
+				     ffeinfo_basictype (ffebld_info (b)),
+				     ffeinfo_kindtype (ffebld_info (b)),
+				     b->u.arrter.size, NULL);
+	  fprintf (dmpout, ">");
+	  break;
+
+	case FFEBLD_opLABTER:
+	  if (b->u.labter == NULL)
+	    fprintf (dmpout, "<>");
+	  else
+	    fprintf (dmpout, "<%" ffelabValue_f "u>", ffelab_value (b->u.labter));
+	  break;
+
+	case FFEBLD_opLABTOK:
+	  fprintf (dmpout, "<%s>", ffelex_token_text (b->u.labtok));
+	  break;
+
+	case FFEBLD_opSYMTER:
+	  fprintf (dmpout, "<");
+	  ffesymbol_dump (b->u.symter.symbol);
+	  if ((b->u.symter.generic != FFEINTRIN_genNONE)
+	      || (b->u.symter.specific != FFEINTRIN_specNONE))
+	    fprintf (dmpout, "{%s:%s:%s}",
+		     ffeintrin_name_generic (b->u.symter.generic),
+		     ffeintrin_name_specific (b->u.symter.specific),
+		ffeintrin_name_implementation (b->u.symter.implementation));
+	  if (b->u.symter.do_iter)
+	    fprintf (dmpout, "{/do-iter}");
+	  fprintf (dmpout, ">");
+	  break;
+
+	default:
+	  break;
+	}
+    }
+}
+
+/* ffebld_dump_prefix -- Dump the prefix for a constant of a given type
+
+   ffebld_dump_prefix(dmpout,FFEINFO_basictypeINTEGER,
+	 FFEINFO_kindtypeINTEGER1);  */
+
+void
+ffebld_dump_prefix (FILE *out, ffeinfoBasictype bt, ffeinfoKindtype kt)
+{
+  switch (bt)
+    {
+    case FFEINFO_basictypeINTEGER:
+      switch (kt)
+	{
+#if FFETARGET_okINTEGER1
+	case FFEINFO_kindtypeINTEGER1:
+	  fprintf (out, "I" STRX (FFETARGET_kindINTEGER1) "/");
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	case FFEINFO_kindtypeINTEGER2:
+	  fprintf (out, "I" STRX (FFETARGET_kindINTEGER2) "/");
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	case FFEINFO_kindtypeINTEGER3:
+	  fprintf (out, "I" STRX (FFETARGET_kindINTEGER3) "/");
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	case FFEINFO_kindtypeINTEGER4:
+	  fprintf (out, "I" STRX (FFETARGET_kindINTEGER4) "/");
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER5
+	case FFEINFO_kindtypeINTEGER5:
+	  fprintf (out, "I" STRX (FFETARGET_kindINTEGER5) "/");
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER6
+	case FFEINFO_kindtypeINTEGER6:
+	  fprintf (out, "I" STRX (FFETARGET_kindINTEGER6) "/");
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER7
+	case FFEINFO_kindtypeINTEGER7:
+	  fprintf (out, "I" STRX (FFETARGET_kindINTEGER7) "/");
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER8
+	case FFEINFO_kindtypeINTEGER8:
+	  fprintf (out, "I" STRX (FFETARGET_kindINTEGER8) "/");
+	  break;
+#endif
+
+	default:
+	  assert ("bad INTEGER kindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeLOGICAL:
+      switch (kt)
+	{
+#if FFETARGET_okLOGICAL1
+	case FFEINFO_kindtypeLOGICAL1:
+	  fprintf (out, "L" STRX (FFETARGET_kindLOGICAL1) "/");
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+	case FFEINFO_kindtypeLOGICAL2:
+	  fprintf (out, "L" STRX (FFETARGET_kindLOGICAL2) "/");
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+	case FFEINFO_kindtypeLOGICAL3:
+	  fprintf (out, "L" STRX (FFETARGET_kindLOGICAL3) "/");
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+	case FFEINFO_kindtypeLOGICAL4:
+	  fprintf (out, "L" STRX (FFETARGET_kindLOGICAL4) "/");
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL5
+	case FFEINFO_kindtypeLOGICAL5:
+	  fprintf (out, "L" STRX (FFETARGET_kindLOGICAL5) "/");
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL6
+	case FFEINFO_kindtypeLOGICAL6:
+	  fprintf (out, "L" STRX (FFETARGET_kindLOGICAL6) "/");
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL7
+	case FFEINFO_kindtypeLOGICAL7:
+	  fprintf (out, "L" STRX (FFETARGET_kindLOGICAL7) "/");
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL8
+	case FFEINFO_kindtypeLOGICAL8:
+	  fprintf (out, "L" STRX (FFETARGET_kindLOGICAL8) "/");
+	  break;
+#endif
+
+	default:
+	  assert ("bad LOGICAL kindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeREAL:
+      switch (kt)
+	{
+#if FFETARGET_okREAL1
+	case FFEINFO_kindtypeREAL1:
+	  fprintf (out, "R" STRX (FFETARGET_kindREAL1) "/");
+	  break;
+#endif
+
+#if FFETARGET_okREAL2
+	case FFEINFO_kindtypeREAL2:
+	  fprintf (out, "R" STRX (FFETARGET_kindREAL2) "/");
+	  break;
+#endif
+
+#if FFETARGET_okREAL3
+	case FFEINFO_kindtypeREAL3:
+	  fprintf (out, "R" STRX (FFETARGET_kindREAL3) "/");
+	  break;
+#endif
+
+#if FFETARGET_okREAL4
+	case FFEINFO_kindtypeREAL4:
+	  fprintf (out, "R" STRX (FFETARGET_kindREAL4) "/");
+	  break;
+#endif
+
+#if FFETARGET_okREAL5
+	case FFEINFO_kindtypeREAL5:
+	  fprintf (out, "R" STRX (FFETARGET_kindREAL5) "/");
+	  break;
+#endif
+
+#if FFETARGET_okREAL6
+	case FFEINFO_kindtypeREAL6:
+	  fprintf (out, "R" STRX (FFETARGET_kindREAL6) "/");
+	  break;
+#endif
+
+#if FFETARGET_okREAL7
+	case FFEINFO_kindtypeREAL7:
+	  fprintf (out, "R" STRX (FFETARGET_kindREAL7) "/");
+	  break;
+#endif
+
+#if FFETARGET_okREAL8
+	case FFEINFO_kindtypeREAL8:
+	  fprintf (out, "R" STRX (FFETARGET_kindREAL8) "/");
+	  break;
+#endif
+
+	default:
+	  assert ("bad REAL kindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCOMPLEX:
+      switch (kt)
+	{
+#if FFETARGET_okCOMPLEX1
+	case FFEINFO_kindtypeREAL1:
+	  fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX1) "/");
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+	case FFEINFO_kindtypeREAL2:
+	  fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX2) "/");
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+	case FFEINFO_kindtypeREAL3:
+	  fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX3) "/");
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+	case FFEINFO_kindtypeREAL4:
+	  fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX4) "/");
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX5
+	case FFEINFO_kindtypeREAL5:
+	  fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX5) "/");
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX6
+	case FFEINFO_kindtypeREAL6:
+	  fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX6) "/");
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX7
+	case FFEINFO_kindtypeREAL7:
+	  fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX7) "/");
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX8
+	case FFEINFO_kindtypeREAL8:
+	  fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX8) "/");
+	  break;
+#endif
+
+	default:
+	  assert ("bad COMPLEX kindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCHARACTER:
+      switch (kt)
+	{
+#if FFETARGET_okCHARACTER1
+	case FFEINFO_kindtypeCHARACTER1:
+	  fprintf (out, "A" STRX (FFETARGET_kindCHARACTER1) "/");
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER2
+	case FFEINFO_kindtypeCHARACTER2:
+	  fprintf (out, "A" STRX (FFETARGET_kindCHARACTER2) "/");
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+	case FFEINFO_kindtypeCHARACTER3:
+	  fprintf (out, "A" STRX (FFETARGET_kindCHARACTER3) "/");
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+	case FFEINFO_kindtypeCHARACTER4:
+	  fprintf (out, "A" STRX (FFETARGET_kindCHARACTER4) "/");
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER5
+	case FFEINFO_kindtypeCHARACTER5:
+	  fprintf (out, "A" STRX (FFETARGET_kindCHARACTER5) "/");
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER6
+	case FFEINFO_kindtypeCHARACTER6:
+	  fprintf (out, "A" STRX (FFETARGET_kindCHARACTER6) "/");
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER7
+	case FFEINFO_kindtypeCHARACTER7:
+	  fprintf (out, "A" STRX (FFETARGET_kindCHARACTER7) "/");
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER8
+	case FFEINFO_kindtypeCHARACTER8:
+	  fprintf (out, "A" STRX (FFETARGET_kindCHARACTER8) "/");
+	  break;
+#endif
+
+	default:
+	  assert ("bad CHARACTER kindtype" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad basictype" == NULL);
+      fprintf (out, "?/?");
+      break;
+    }
+}
+
+/* ffebld_init_0 -- Initialize the module
+
+   ffebld_init_0();  */
+
+void
+ffebld_init_0 ()
+{
+  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 ()
+{
+#if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstFILE_
+  int i;
+
+#if FFETARGET_okCHARACTER1
+  ffebld_constant_character1_ = NULL;
+#endif
+#if FFETARGET_okCHARACTER2
+  ffebld_constant_character2_ = NULL;
+#endif
+#if FFETARGET_okCHARACTER3
+  ffebld_constant_character3_ = NULL;
+#endif
+#if FFETARGET_okCHARACTER4
+  ffebld_constant_character4_ = NULL;
+#endif
+#if FFETARGET_okCHARACTER5
+  ffebld_constant_character5_ = NULL;
+#endif
+#if FFETARGET_okCHARACTER6
+  ffebld_constant_character6_ = NULL;
+#endif
+#if FFETARGET_okCHARACTER7
+  ffebld_constant_character7_ = NULL;
+#endif
+#if FFETARGET_okCHARACTER8
+  ffebld_constant_character8_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX1
+  ffebld_constant_complex1_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX2
+  ffebld_constant_complex2_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX3
+  ffebld_constant_complex3_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX4
+  ffebld_constant_complex4_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX5
+  ffebld_constant_complex5_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX6
+  ffebld_constant_complex6_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX7
+  ffebld_constant_complex7_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX8
+  ffebld_constant_complex8_ = NULL;
+#endif
+#if FFETARGET_okINTEGER1
+  ffebld_constant_integer1_ = NULL;
+#endif
+#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_okINTEGER5
+  ffebld_constant_integer5_ = NULL;
+#endif
+#if FFETARGET_okINTEGER6
+  ffebld_constant_integer6_ = NULL;
+#endif
+#if FFETARGET_okINTEGER7
+  ffebld_constant_integer7_ = NULL;
+#endif
+#if FFETARGET_okINTEGER8
+  ffebld_constant_integer8_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL1
+  ffebld_constant_logical1_ = NULL;
+#endif
+#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_okLOGICAL5
+  ffebld_constant_logical5_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL6
+  ffebld_constant_logical6_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL7
+  ffebld_constant_logical7_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL8
+  ffebld_constant_logical8_ = NULL;
+#endif
+#if FFETARGET_okREAL1
+  ffebld_constant_real1_ = NULL;
+#endif
+#if FFETARGET_okREAL2
+  ffebld_constant_real2_ = NULL;
+#endif
+#if FFETARGET_okREAL3
+  ffebld_constant_real3_ = NULL;
+#endif
+#if FFETARGET_okREAL4
+  ffebld_constant_real4_ = NULL;
+#endif
+#if FFETARGET_okREAL5
+  ffebld_constant_real5_ = NULL;
+#endif
+#if FFETARGET_okREAL6
+  ffebld_constant_real6_ = NULL;
+#endif
+#if FFETARGET_okREAL7
+  ffebld_constant_real7_ = NULL;
+#endif
+#if FFETARGET_okREAL8
+  ffebld_constant_real8_ = NULL;
+#endif
+  ffebld_constant_hollerith_ = NULL;
+  for (i = FFEBLD_constTYPELESS_FIRST; i <= FFEBLD_constTYPELESS_LAST; ++i)
+    ffebld_constant_typeless_[i - FFEBLD_constTYPELESS_FIRST] = NULL;
+#endif
+}
+
+/* ffebld_init_2 -- Initialize the module
+
+   ffebld_init_2();  */
+
+void
+ffebld_init_2 ()
+{
+#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_okCHARACTER2
+  ffebld_constant_character2_ = NULL;
+#endif
+#if FFETARGET_okCHARACTER3
+  ffebld_constant_character3_ = NULL;
+#endif
+#if FFETARGET_okCHARACTER4
+  ffebld_constant_character4_ = NULL;
+#endif
+#if FFETARGET_okCHARACTER5
+  ffebld_constant_character5_ = NULL;
+#endif
+#if FFETARGET_okCHARACTER6
+  ffebld_constant_character6_ = NULL;
+#endif
+#if FFETARGET_okCHARACTER7
+  ffebld_constant_character7_ = NULL;
+#endif
+#if FFETARGET_okCHARACTER8
+  ffebld_constant_character8_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX1
+  ffebld_constant_complex1_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX2
+  ffebld_constant_complex2_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX3
+  ffebld_constant_complex3_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX4
+  ffebld_constant_complex4_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX5
+  ffebld_constant_complex5_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX6
+  ffebld_constant_complex6_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX7
+  ffebld_constant_complex7_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX8
+  ffebld_constant_complex8_ = NULL;
+#endif
+#if FFETARGET_okINTEGER1
+  ffebld_constant_integer1_ = NULL;
+#endif
+#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_okINTEGER5
+  ffebld_constant_integer5_ = NULL;
+#endif
+#if FFETARGET_okINTEGER6
+  ffebld_constant_integer6_ = NULL;
+#endif
+#if FFETARGET_okINTEGER7
+  ffebld_constant_integer7_ = NULL;
+#endif
+#if FFETARGET_okINTEGER8
+  ffebld_constant_integer8_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL1
+  ffebld_constant_logical1_ = NULL;
+#endif
+#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_okLOGICAL5
+  ffebld_constant_logical5_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL6
+  ffebld_constant_logical6_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL7
+  ffebld_constant_logical7_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL8
+  ffebld_constant_logical8_ = NULL;
+#endif
+#if FFETARGET_okREAL1
+  ffebld_constant_real1_ = NULL;
+#endif
+#if FFETARGET_okREAL2
+  ffebld_constant_real2_ = NULL;
+#endif
+#if FFETARGET_okREAL3
+  ffebld_constant_real3_ = NULL;
+#endif
+#if FFETARGET_okREAL4
+  ffebld_constant_real4_ = NULL;
+#endif
+#if FFETARGET_okREAL5
+  ffebld_constant_real5_ = NULL;
+#endif
+#if FFETARGET_okREAL6
+  ffebld_constant_real6_ = NULL;
+#endif
+#if FFETARGET_okREAL7
+  ffebld_constant_real7_ = NULL;
+#endif
+#if FFETARGET_okREAL8
+  ffebld_constant_real8_ = NULL;
+#endif
+  ffebld_constant_hollerith_ = NULL;
+  for (i = FFEBLD_constTYPELESS_FIRST; i <= FFEBLD_constTYPELESS_LAST; ++i)
+    ffebld_constant_typeless_[i - FFEBLD_constTYPELESS_FIRST] = NULL;
+#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 ();
+#if FFEBLD_BLANK_
+  *x = ffebld_blank_;
+#endif
+  x->op = FFEBLD_opACCTER;
+  x->u.accter.array = a;
+  x->u.accter.bits = b;
+  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 ();
+#if FFEBLD_BLANK_
+  *x = ffebld_blank_;
+#endif
+  x->op = FFEBLD_opARRTER;
+  x->u.arrter.array = a;
+  x->u.arrter.size = size;
+  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 ();
+#if FFEBLD_BLANK_
+  *x = ffebld_blank_;
+#endif
+  x->op = FFEBLD_opCONTER;
+  x->u.conter.expr = c;
+  x->u.conter.orig = o;
+  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 ();
+#if FFEBLD_BLANK_
+  *x = ffebld_blank_;
+#endif
+  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 ();
+#if FFEBLD_BLANK_
+  *x = ffebld_blank_;
+#endif
+  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 ();
+#if FFEBLD_BLANK_
+  *x = ffebld_blank_;
+#endif
+  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 ();
+#if FFEBLD_BLANK_
+  *x = ffebld_blank_;
+#endif
+  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 ();
+#if FFEBLD_BLANK_
+  *x = ffebld_blank_;
+#endif
+  x->op = o;
+  x->u.nonter.left = left;
+  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 ();
+#if FFEBLD_BLANK_
+  *x = ffebld_blank_;
+#endif
+  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 ();
+#if FFEBLD_BLANK_
+  *x = ffebld_blank_;
+#endif
+  x->op = o;
+  x->u.nonter.left = left;
+  x->u.nonter.right = right;
+  return x;
+}
+
+/* ffebld_pool_pop -- Pop ffebld's pool stack
+
+   ffebld_pool_pop();  */
+
+void
+ffebld_pool_pop ()
+{
+  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.  */
+
+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
new file mode 100644
index 00000000000..a9dbe9f2e03
--- /dev/null
+++ b/gcc/f/bld.h
@@ -0,0 +1,1009 @@
+/* bld.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_bld
+#define _H_f_bld
+
+/* 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
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+#define FFEBLD_whereconstCURRENT_ FFEBLD_whereconstPROGUNIT_
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#define FFEBLD_whereconstCURRENT_ FFEBLD_whereconstFILE_
+#else
+#error
+#endif
+
+/* Structure definitions. */
+
+#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_okINTEGER5
+    ffetargetInteger5 integer5;
+#endif
+#if FFETARGET_okINTEGER6
+    ffetargetInteger6 integer6;
+#endif
+#if FFETARGET_okINTEGER7
+    ffetargetInteger7 integer7;
+#endif
+#if FFETARGET_okINTEGER8
+    ffetargetInteger8 integer8;
+#endif
+#if FFETARGET_okLOGICAL1
+    ffetargetLogical1 logical1;
+#endif
+#if FFETARGET_okLOGICAL2
+    ffetargetLogical2 logical2;
+#endif
+#if FFETARGET_okLOGICAL3
+    ffetargetLogical3 logical3;
+#endif
+#if FFETARGET_okLOGICAL4
+    ffetargetLogical4 logical4;
+#endif
+#if FFETARGET_okLOGICAL5
+    ffetargetLogical5 logical5;
+#endif
+#if FFETARGET_okLOGICAL6
+    ffetargetLogical6 logical6;
+#endif
+#if FFETARGET_okLOGICAL7
+    ffetargetLogical7 logical7;
+#endif
+#if FFETARGET_okLOGICAL8
+    ffetargetLogical8 logical8;
+#endif
+#if FFETARGET_okREAL1
+    ffetargetReal1 real1;
+#endif
+#if FFETARGET_okREAL2
+    ffetargetReal2 real2;
+#endif
+#if FFETARGET_okREAL3
+    ffetargetReal3 real3;
+#endif
+#if FFETARGET_okREAL4
+    ffetargetReal4 real4;
+#endif
+#if FFETARGET_okREAL5
+    ffetargetReal5 real5;
+#endif
+#if FFETARGET_okREAL6
+    ffetargetReal6 real6;
+#endif
+#if FFETARGET_okREAL7
+    ffetargetReal7 real7;
+#endif
+#if FFETARGET_okREAL8
+    ffetargetReal8 real8;
+#endif
+#if FFETARGET_okCOMPLEX1
+    ffetargetComplex1 complex1;
+#endif
+#if FFETARGET_okCOMPLEX2
+    ffetargetComplex2 complex2;
+#endif
+#if FFETARGET_okCOMPLEX3
+    ffetargetComplex3 complex3;
+#endif
+#if FFETARGET_okCOMPLEX4
+    ffetargetComplex4 complex4;
+#endif
+#if FFETARGET_okCOMPLEX5
+    ffetargetComplex5 complex5;
+#endif
+#if FFETARGET_okCOMPLEX6
+    ffetargetComplex6 complex6;
+#endif
+#if FFETARGET_okCOMPLEX7
+    ffetargetComplex7 complex7;
+#endif
+#if FFETARGET_okCOMPLEX8
+    ffetargetComplex8 complex8;
+#endif
+#if FFETARGET_okCHARACTER1
+    ffetargetCharacter1 character1;
+#endif
+#if FFETARGET_okCHARACTER2
+    ffetargetCharacter2 character2;
+#endif
+#if FFETARGET_okCHARACTER3
+    ffetargetCharacter3 character3;
+#endif
+#if FFETARGET_okCHARACTER4
+    ffetargetCharacter4 character4;
+#endif
+#if FFETARGET_okCHARACTER5
+    ffetargetCharacter5 character5;
+#endif
+#if FFETARGET_okCHARACTER6
+    ffetargetCharacter6 character6;
+#endif
+#if FFETARGET_okCHARACTER7
+    ffetargetCharacter7 character7;
+#endif
+#if FFETARGET_okCHARACTER8
+    ffetargetCharacter8 character8;
+#endif
+  };
+
+union _ffebld_constant_array_
+  {
+#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_okINTEGER5
+    ffetargetInteger5 *integer5;
+#endif
+#if FFETARGET_okINTEGER6
+    ffetargetInteger6 *integer6;
+#endif
+#if FFETARGET_okINTEGER7
+    ffetargetInteger7 *integer7;
+#endif
+#if FFETARGET_okINTEGER8
+    ffetargetInteger8 *integer8;
+#endif
+#if FFETARGET_okLOGICAL1
+    ffetargetLogical1 *logical1;
+#endif
+#if FFETARGET_okLOGICAL2
+    ffetargetLogical2 *logical2;
+#endif
+#if FFETARGET_okLOGICAL3
+    ffetargetLogical3 *logical3;
+#endif
+#if FFETARGET_okLOGICAL4
+    ffetargetLogical4 *logical4;
+#endif
+#if FFETARGET_okLOGICAL5
+    ffetargetLogical5 *logical5;
+#endif
+#if FFETARGET_okLOGICAL6
+    ffetargetLogical6 *logical6;
+#endif
+#if FFETARGET_okLOGICAL7
+    ffetargetLogical7 *logical7;
+#endif
+#if FFETARGET_okLOGICAL8
+    ffetargetLogical8 *logical8;
+#endif
+#if FFETARGET_okREAL1
+    ffetargetReal1 *real1;
+#endif
+#if FFETARGET_okREAL2
+    ffetargetReal2 *real2;
+#endif
+#if FFETARGET_okREAL3
+    ffetargetReal3 *real3;
+#endif
+#if FFETARGET_okREAL4
+    ffetargetReal4 *real4;
+#endif
+#if FFETARGET_okREAL5
+    ffetargetReal5 *real5;
+#endif
+#if FFETARGET_okREAL6
+    ffetargetReal6 *real6;
+#endif
+#if FFETARGET_okREAL7
+    ffetargetReal7 *real7;
+#endif
+#if FFETARGET_okREAL8
+    ffetargetReal8 *real8;
+#endif
+#if FFETARGET_okCOMPLEX1
+    ffetargetComplex1 *complex1;
+#endif
+#if FFETARGET_okCOMPLEX2
+    ffetargetComplex2 *complex2;
+#endif
+#if FFETARGET_okCOMPLEX3
+    ffetargetComplex3 *complex3;
+#endif
+#if FFETARGET_okCOMPLEX4
+    ffetargetComplex4 *complex4;
+#endif
+#if FFETARGET_okCOMPLEX5
+    ffetargetComplex5 *complex5;
+#endif
+#if FFETARGET_okCOMPLEX6
+    ffetargetComplex6 *complex6;
+#endif
+#if FFETARGET_okCOMPLEX7
+    ffetargetComplex7 *complex7;
+#endif
+#if FFETARGET_okCOMPLEX8
+    ffetargetComplex8 *complex8;
+#endif
+#if FFETARGET_okCHARACTER1
+    ffetargetCharacterUnit1 *character1;
+#endif
+#if FFETARGET_okCHARACTER2
+    ffetargetCharacterUnit2 *character2;
+#endif
+#if FFETARGET_okCHARACTER3
+    ffetargetCharacterUnit3 *character3;
+#endif
+#if FFETARGET_okCHARACTER4
+    ffetargetCharacterUnit4 *character4;
+#endif
+#if FFETARGET_okCHARACTER5
+    ffetargetCharacterUnit5 *character5;
+#endif
+#if FFETARGET_okCHARACTER6
+    ffetargetCharacterUnit6 *character6;
+#endif
+#if FFETARGET_okCHARACTER7
+    ffetargetCharacterUnit7 *character7;
+#endif
+#if FFETARGET_okCHARACTER8
+    ffetargetCharacterUnit8 *character8;
+#endif
+  };
+
+struct _ffebld_
+  {
+    ffebldOp op;
+    ffeinfo info;		/* Not used or valid for
+				   op=={STAR,ITEM,BOUNDS,REPEAT,LABTER,
+				   LABTOK,IMPDO}. */
+    union
+      {
+	struct
+	  {
+	    ffebld left;
+	    ffebld right;
+	  }
+	nonter;
+	struct
+	  {
+	    ffebld head;
+	    ffebld trail;
+	  }
+	item;
+	struct
+	  {
+	    ffebldConstant expr;
+	    ffebld orig;	/* Original expression, or NULL if none. */
+	  }
+	conter;
+	struct
+	  {
+	    ffebldConstantArray array;
+	    ffetargetOffset size;
+	  }
+	arrter;
+	struct
+	  {
+	    ffebldConstantArray array;
+	    ffebit bits;
+	  }
+	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;
+#ifdef FFECOM_constantHOOK
+    ffecomConstant hook;	/* Whatever the compiler/backend wants! */
+#endif
+    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 ffebldArity ffebld_arity_op_[];
+extern struct _ffebld_pool_stack_ ffebld_pool_stack_;
+
+/* Declare functions with prototypes. */
+
+int ffebld_constant_cmp (ffebldConstant c1, ffebldConstant c2);
+void ffebld_constant_dump (ffebldConstant c);
+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_okCHARACTER2
+ffebldConstant ffebld_constant_new_character2 (ffelexToken t);
+ffebldConstant ffebld_constant_new_character2_val (ffetargetCharacter2 val);
+#endif
+#if FFETARGET_okCHARACTER3
+ffebldConstant ffebld_constant_new_character3 (ffelexToken t);
+ffebldConstant ffebld_constant_new_character3_val (ffetargetCharacter3 val);
+#endif
+#if FFETARGET_okCHARACTER4
+ffebldConstant ffebld_constant_new_character4 (ffelexToken t);
+ffebldConstant ffebld_constant_new_character4_val (ffetargetCharacter4 val);
+#endif
+#if FFETARGET_okCHARACTER5
+ffebldConstant ffebld_constant_new_character5 (ffelexToken t);
+ffebldConstant ffebld_constant_new_character5_val (ffetargetCharacter5 val);
+#endif
+#if FFETARGET_okCHARACTER6
+ffebldConstant ffebld_constant_new_character6 (ffelexToken t);
+ffebldConstant ffebld_constant_new_character6_val (ffetargetCharacter6 val);
+#endif
+#if FFETARGET_okCHARACTER7
+ffebldConstant ffebld_constant_new_character7 (ffelexToken t);
+ffebldConstant ffebld_constant_new_character7_val (ffetargetCharacter7 val);
+#endif
+#if FFETARGET_okCHARACTER8
+ffebldConstant ffebld_constant_new_character8 (ffelexToken t);
+ffebldConstant ffebld_constant_new_character8_val (ffetargetCharacter8 val);
+#endif
+#if FFETARGET_okCOMPLEX1
+ffebldConstant ffebld_constant_new_complex1 (ffebldConstant real,
+					     ffebldConstant imaginary);
+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
+#if FFETARGET_okCOMPLEX4
+ffebldConstant ffebld_constant_new_complex4 (ffebldConstant real,
+					     ffebldConstant imaginary);
+ffebldConstant ffebld_constant_new_complex4_val (ffetargetComplex4 val);
+#endif
+#if FFETARGET_okCOMPLEX5
+ffebldConstant ffebld_constant_new_complex5 (ffebldConstant real,
+					     ffebldConstant imaginary);
+ffebldConstant ffebld_constant_new_complex5_val (ffetargetComplex5 val);
+#endif
+#if FFETARGET_okCOMPLEX6
+ffebldConstant ffebld_constant_new_complex6 (ffebldConstant real,
+					     ffebldConstant imaginary);
+ffebldConstant ffebld_constant_new_complex6_val (ffetargetComplex6 val);
+#endif
+#if FFETARGET_okCOMPLEX7
+ffebldConstant ffebld_constant_new_complex7 (ffebldConstant real,
+					     ffebldConstant imaginary);
+ffebldConstant ffebld_constant_new_complex7_val (ffetargetComplex7 val);
+#endif
+#if FFETARGET_okCOMPLEX8
+ffebldConstant ffebld_constant_new_complex8 (ffebldConstant real,
+					     ffebldConstant imaginary);
+ffebldConstant ffebld_constant_new_complex8_val (ffetargetComplex8 val);
+#endif
+ffebldConstant ffebld_constant_new_hollerith (ffelexToken t);
+ffebldConstant ffebld_constant_new_hollerith_val (ffetargetHollerith val);
+#if FFETARGET_okINTEGER1
+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
+#if FFETARGET_okINTEGER5
+ffebldConstant ffebld_constant_new_integer5 (ffelexToken t);
+ffebldConstant ffebld_constant_new_integer5_val (ffetargetInteger5 val);
+#endif
+#if FFETARGET_okINTEGER6
+ffebldConstant ffebld_constant_new_integer6 (ffelexToken t);
+ffebldConstant ffebld_constant_new_integer6_val (ffetargetInteger6 val);
+#endif
+#if FFETARGET_okINTEGER7
+ffebldConstant ffebld_constant_new_integer7 (ffelexToken t);
+ffebldConstant ffebld_constant_new_integer7_val (ffetargetInteger7 val);
+#endif
+#if FFETARGET_okINTEGER8
+ffebldConstant ffebld_constant_new_integer8 (ffelexToken t);
+ffebldConstant ffebld_constant_new_integer8_val (ffetargetInteger8 val);
+#endif
+ffebldConstant ffebld_constant_new_integerbinary (ffelexToken t);
+ffebldConstant ffebld_constant_new_integerhex (ffelexToken t);
+ffebldConstant ffebld_constant_new_integeroctal (ffelexToken t);
+#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_okLOGICAL5
+ffebldConstant ffebld_constant_new_logical5 (bool truth);
+ffebldConstant ffebld_constant_new_logical5_val (ffetargetLogical5 val);
+#endif
+#if FFETARGET_okLOGICAL6
+ffebldConstant ffebld_constant_new_logical6 (bool truth);
+ffebldConstant ffebld_constant_new_logical6_val (ffetargetLogical6 val);
+#endif
+#if FFETARGET_okLOGICAL7
+ffebldConstant ffebld_constant_new_logical7 (bool truth);
+ffebldConstant ffebld_constant_new_logical7_val (ffetargetLogical7 val);
+#endif
+#if FFETARGET_okLOGICAL8
+ffebldConstant ffebld_constant_new_logical8 (bool truth);
+ffebldConstant ffebld_constant_new_logical8_val (ffetargetLogical8 val);
+#endif
+#if FFETARGET_okREAL1
+ffebldConstant ffebld_constant_new_real1 (ffelexToken integer,
+	    ffelexToken decimal, ffelexToken fraction, ffelexToken exponent,
+		    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
+#if FFETARGET_okREAL4
+ffebldConstant ffebld_constant_new_real4 (ffelexToken integer,
+	    ffelexToken decimal, ffelexToken fraction, ffelexToken exponent,
+		    ffelexToken exponent_sign, ffelexToken exponent_digits);
+ffebldConstant ffebld_constant_new_real4_val (ffetargetReal4 val);
+#endif
+#if FFETARGET_okREAL5
+ffebldConstant ffebld_constant_new_real5 (ffelexToken integer,
+	    ffelexToken decimal, ffelexToken fraction, ffelexToken exponent,
+		    ffelexToken exponent_sign, ffelexToken exponent_digits);
+ffebldConstant ffebld_constant_new_real5_val (ffetargetReal5 val);
+#endif
+#if FFETARGET_okREAL6
+ffebldConstant ffebld_constant_new_real6 (ffelexToken integer,
+	    ffelexToken decimal, ffelexToken fraction, ffelexToken exponent,
+		    ffelexToken exponent_sign, ffelexToken exponent_digits);
+ffebldConstant ffebld_constant_new_real6_val (ffetargetReal6 val);
+#endif
+#if FFETARGET_okREAL7
+ffebldConstant ffebld_constant_new_real7 (ffelexToken integer,
+	    ffelexToken decimal, ffelexToken fraction, ffelexToken exponent,
+		    ffelexToken exponent_sign, ffelexToken exponent_digits);
+ffebldConstant ffebld_constant_new_real7_val (ffetargetReal7 val);
+#endif
+#if FFETARGET_okREAL8
+ffebldConstant ffebld_constant_new_real8 (ffelexToken integer,
+	    ffelexToken decimal, ffelexToken fraction, ffelexToken exponent,
+		    ffelexToken exponent_sign, ffelexToken exponent_digits);
+ffebldConstant ffebld_constant_new_real8_val (ffetargetReal8 val);
+#endif
+ffebldConstant ffebld_constant_new_typeless_bm (ffelexToken t);
+ffebldConstant ffebld_constant_new_typeless_bv (ffelexToken t);
+ffebldConstant ffebld_constant_new_typeless_hxm (ffelexToken t);
+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);
+void ffebld_constantarray_dump (ffebldConstantArray array, ffeinfoBasictype bt,
+		     ffeinfoKindtype kt, ffetargetOffset size, ffebit bits);
+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_constantunion_dump (ffebldConstantUnion u, ffeinfoBasictype bt,
+				ffeinfoKindtype kt);
+void ffebld_dump (ffebld b);
+void ffebld_dump_prefix (FILE *out, ffeinfoBasictype bt, ffeinfoKindtype kt);
+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);
+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_set_bits(b,bt) ((b)->u.accter.bits = (bt))
+#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_set_size(b,s) ((b)->u.arrter.size = (s))
+#define ffebld_arrter_size(b) ((b)->u.arrter.size)
+#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_set_orig(b,o) ((b)->u.conter.orig = (o))
+#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_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_op(b) ((b)->op)
+#define ffebld_pool() (ffebld_pool_stack_.pool)
+#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((b)->info))
+#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)
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/bugs.texi b/gcc/f/bugs.texi
new file mode 100644
index 00000000000..692e1b3a12f
--- /dev/null
+++ b/gcc/f/bugs.texi
@@ -0,0 +1,287 @@
+@c Copyright (C) 1995-1997 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 1996-06-24
+
+@ifclear BUGSONLY
+@node Actual Bugs
+@section Actual Bugs We Haven't Fixed Yet
+@end ifclear
+
+This section identifies bugs that @code{g77} @emph{users}
+might run into.
+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.
+
+For information on bugs that might afflict people who
+configure, port, build, and install @code{g77},
+@ref{Problems Installing}.
+
+@itemize @bullet
+@cindex SIGNAL() intrinsic
+@cindex intrinsics, SIGNAL()
+@item
+Work is needed on the @code{SIGNAL()} intrinsic to ensure
+that pointers and integers are properly handled on all
+targets, including 64-bit machines.
+
+@cindex -fugly-comma option
+@cindex options, -fugly-comma
+@item
+When using @samp{-fugly-comma}, @code{g77} assumes an extra
+@samp{%VAL(0)} argument is to be passed to intrinsics
+taking no arguments, such as @code{IARGC()}, which in
+turn reject such a call.
+Although this has been worked around for 0.5.18 due
+to changes in the handling of intrinsics,
+@code{g77} needs to do the ugly-argument-appending trick
+only for external-function invocation, as this would
+probably be more consistent with compilers that default
+to using that trick.
+
+@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.
+(Probably improved, but not wholly fixed, in 0.5.21.)
+
+@item
+The @code{g77} command itself should more faithfully process
+options the way the @code{gcc} command does.
+For example, @code{gcc} accepts abbreviated forms of long options,
+@code{g77} generally doesn't.
+
+@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.
+This is to be fixed in version 0.6, when @code{g77} will use the
+@code{gcc} back end's constant-handling mechanisms to replace its own.
+
+@cindex compiler speed
+@cindex speed, of compiler
+@cindex compiler memory usage
+@cindex memory usage, of compiler
+@cindex large aggregate areas
+@cindex initialization
+@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.
+This is to be mitigated somewhat in version 0.6.
+
+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.
+@xref{Large Initialization,,Initialization of Large Aggregate Areas},
+for information on how to change the point at which
+@code{g77} decides to issue this warning.
+
+@cindex debugging
+@cindex common blocks
+@cindex equivalence areas
+@cindex local equivalence areas
+@item
+@code{g77} doesn't emit variable and array members of common blocks for use
+with a debugger (the @samp{-g} command-line option).
+The code is present to do this, but doesn't work with at least
+one debug format---perhaps it works with others.
+And it turns out there's a similar bug for
+local equivalence areas, so that has been disabled as well.
+
+As of Version 0.5.19, a temporary kludge solution is provided whereby
+some rudimentary information on a member is written as a string that
+is the member's value as a character string.
+
+@xref{Code Gen Options,,Options for Code Generation Conventions},
+for information on the @samp{-fdebug-kludge} option.
+
+@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 @samp{MAIN__} (or @samp{MAIN___} or @samp{MAIN_} if
+@samp{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 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's good for
+performance).
+
+It is possible that this is not a real bug, and could be considered
+a performance feature, but it might be important to provide
+the ability to Fortran code to specify minimum padding for
+aggregate areas such as common blocks---and, certainly, there
+is the potential, with the current setup, for interface differences
+in the way such areas are laid out between @code{g77} and other
+compilers.
+
+@item
+Some crashes occur when compiling under Solaris on x86
+machines.
+
+Nothing has been heard about any such problems for some time,
+so this is considering a closed item as of 0.5.20.
+Please submit any bug reports pertinent to @code{g77}'s support
+for Solaris/x86 systems.
+
+@cindex RS/6000 support
+@cindex support, RS/6000
+@item
+RS/6000 support is not complete as of the gcc 2.6.3 back end.
+The 2.7.0 back end appears to fix this problem, or at least mitigate
+it significantly, but there is at least one known problem that is
+likely to be a code-generation bug in @file{gcc-2.7.0} plus
+@file{g77-0.5.16}.
+This problem shows up only when compiling the Fortran program with @samp{-O}.
+
+Nothing has been heard about any RS/6000 problems for some time,
+so this is considering a closed item as of 0.5.20.
+Please submit any bug reports pertinent to @code{g77}'s support
+for RS/6000 systems.
+
+@cindex SGI support
+@cindex support, SGI
+@item
+SGI support is known to be a bit buggy.
+The known problem shows up only when compiling the Fortran program with
+@samp{-O}.
+
+It is possible these problems have all been fixed in 0.5.20 by
+emulating complex arithmetic in the front end.
+Please submit any bug reports pertinent to @code{g77}'s support
+for SGI systems.
+
+@cindex Alpha, support
+@cindex support, Alpha
+@item
+@code{g77} doesn't work perfectly on 64-bit configurations such as the Alpha.
+This problem is expected to be largely resolved as of version 0.5.20,
+and further addressed by 0.5.21.
+Version 0.6 should solve most or all related problems (such as
+64-bit machines other than Digital Semiconductor (``DEC'') Alphas).
+
+One known bug that causes a compile-time crash occurs when compiling
+code such as the following with optimization:
+
+@example
+SUBROUTINE CRASH (TEMP)
+INTEGER*2 HALF(2)
+REAL TEMP
+HALF(1) = NINT (TEMP)
+END
+@end example
+
+It is expected that a future version of @code{g77} will have a fix for this
+problem, almost certainly by the time @code{g77} supports the forthcoming
+version 2.8.0 of @code{gcc}.
+
+@cindex COMPLEX support
+@cindex support, COMPLEX
+@item
+Maintainers of gcc report that the back end definitely has ``broken''
+support for @code{COMPLEX} types.
+Based on their input, it seems many of
+the problems affect only the more-general facilities for gcc's
+@code{__complex__} type, such as @code{__complex__ int}
+(where the real and imaginary parts are integers) that GNU
+Fortran does not use.
+
+Version 0.5.20 of @code{g77} works around this
+problem by not using the back end's support for @code{COMPLEX}.
+The new option @samp{-fno-emulate-complex} avoids the work-around,
+reverting to using the same ``broken'' mechanism as that used
+by versions of @code{g77} prior to 0.5.20.
+
+@cindex ELF support
+@cindex support, ELF
+@cindex -fPIC option
+@cindex options, -fPIC
+@item
+There seem to be some problems with passing constants, and perhaps
+general expressions (other than simple variables/arrays), to procedures
+when compiling on some systems (such as i386) with @samp{-fPIC}, as in
+when compiling for ELF targets.
+The symptom is that the assembler complains about invalid opcodes.
+More investigation is needed, but the problem is almost certainly
+in the gcc back end, and it apparently occurs only when
+compiling sufficiently complicated functions @emph{without} the
+@samp{-O} option.
+@end itemize
+
diff --git a/gcc/f/bugs0.texi b/gcc/f/bugs0.texi
new file mode 100644
index 00000000000..e8f6d22e339
--- /dev/null
+++ b/gcc/f/bugs0.texi
@@ -0,0 +1,17 @@
+\input texinfo  @c -*-texinfo-*-
+@c %**start of header 
+@setfilename BUGS
+@set BUGSONLY
+@c %**end of header
+
+@c The immediately following lines apply to the BUGS file
+@c which is generated using this file.
+This file lists known bugs in the GNU Fortran compiler.
+Copyright (C) 1995, 1996 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 Bugs in GNU Fortran
+@include bugs.texi
+@bye
diff --git a/gcc/f/com-rt.def b/gcc/f/com-rt.def
new file mode 100644
index 00000000000..eb2fed5f530
--- /dev/null
+++ b/gcc/f/com-rt.def
@@ -0,0 +1,281 @@
+/* com-rt.def -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995-1997 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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):
+
+   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
+
+*/
+
+DEFGFRT (FFECOM_gfrtCAT, "s_cat", FFECOM_rttypeVOID_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCMP, "s_cmp", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCOPY, "s_copy", FFECOM_rttypeVOID_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtPAUSE, "s_paus", FFECOM_rttypeVOID_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSTOP, "s_stop", FFECOM_rttypeVOID_, 0, TRUE, FALSE)
+
+DEFGFRT (FFECOM_gfrtSRDUE, "s_rdue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtERDUE, "e_rdue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSRSUE, "s_rsue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtERSUE, "e_rsue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSRDFE, "s_rdfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtERDFE, "e_rdfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSRSFI, "s_rsfi", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtERSFI, "e_rsfi", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSRSFE, "s_rsfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtERSFE, "e_rsfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSRSLI, "s_rsli", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtERSLI, "e_rsli", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSRSLE, "s_rsle", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtERSLE, "e_rsle", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSRSNE, "s_rsne", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+
+DEFGFRT (FFECOM_gfrtSWDUE, "s_wdue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtEWDUE, "e_wdue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSWSUE, "s_wsue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtEWSUE, "e_wsue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSWDFE, "s_wdfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtEWDFE, "e_wdfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSWSFI, "s_wsfi", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtEWSFI, "e_wsfi", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSWSFE, "s_wsfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtEWSFE, "e_wsfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSWSLI, "s_wsli", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtEWSLI, "e_wsli", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSWSLE, "s_wsle", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtEWSLE, "e_wsle", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSWSNE, "s_wsne", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+
+DEFGFRT (FFECOM_gfrtDOFIO, "do_fio", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDOLIO, "do_lio", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDOUIO, "do_uio", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+
+DEFGFRT (FFECOM_gfrtFOPEN, "f_open", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFCLOS, "f_clos", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFINQU, "f_inqu", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+
+DEFGFRT (FFECOM_gfrtFBACK, "f_back", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFEND, "f_end", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFREW, "f_rew", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+
+DEFGFRT (FFECOM_gfrtABORT, "G77_abort_0", FFECOM_rttypeVOID_, 0, TRUE, FALSE)
+DEFGFRT (FFECOM_gfrtABS, "r_abs", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtACCESS, "G77_access_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtACOS, "r_acos", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtAIMAG, "r_imag", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtAINT, "r_int", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtALARM, "G77_alarm_0", FFECOM_rttypeVOID_, "&i0", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtALOG, "r_log", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtALOG10, "r_lg10", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtAMOD, "r_mod", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtANINT, "r_nint", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtASIN, "r_asin", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtATAN, "r_atan", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtATAN2, "r_atn2", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCABS, "c_abs", FFECOM_rttypeREAL_F2C_, "&c", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCCOS, "c_cos", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtCEXP, "c_exp", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtCHDIR, "G77_chdir_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCLOG, "c_log", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtCHMOD, "G77_chmod_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCONJG, "r_cnjg", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtCOS, "r_cos", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCOSH, "r_cosh", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCSIN, "c_sin", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtCSQRT, "c_sqrt", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtCTIME, "G77_ctime_0", FFECOM_rttypeCHARACTER_, "&j", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDABS, "d_abs", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDACOS, "d_acos", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDASIN, "d_asin", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDATAN, "d_atan", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDATAN2, "d_atn2", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDATE, "G77_date_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_BESJ0, "j0", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_BESJ1, "j1", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_BESJN, "jn", FFECOM_rttypeDOUBLE_, "id", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_BESY0, "y0", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_BESY1, "y1", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_BESYN, "yn", FFECOM_rttypeDOUBLE_, "id", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDCOS, "d_cos", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDCOSH, "d_cosh", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDDIM, "d_dim", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDERF, "G77_derf_0", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDERFC, "G77_derfc_0", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDEXP, "d_exp", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDIM, "r_dim", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDINT, "d_int", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDLOG, "d_log", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDLOG10, "d_lg10", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDMOD, "d_mod", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDNINT, "d_nint", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDPROD, "d_prod", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDSIGN, "d_sign", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDSIN, "d_sin", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDSINH, "d_sinh", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDSQRT, "d_sqrt", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDTAN, "d_tan", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDTANH, "d_tanh", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDTIME, "G77_dtime_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtERF, "G77_erf_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtERFC, "G77_erfc_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtETIME, "G77_etime_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtEXIT, "G77_exit_0", FFECOM_rttypeVOID_, "&i", TRUE, FALSE)
+DEFGFRT (FFECOM_gfrtEXP, "r_exp", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFDATE, "G77_fdate_0", FFECOM_rttypeCHARACTER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFGET, "G77_fget_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFGETC, "G77_fgetc_0", FFECOM_rttypeINTEGER_, "&i&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFLUSH, "G77_flush_0", FFECOM_rttypeVOID_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFLUSH1, "G77_flush1_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFNUM, "G77_fnum_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFPUT, "G77_fput_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFPUTC, "G77_fputc_0", FFECOM_rttypeINTEGER_, "&i&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFSTAT, "G77_fstat_0", FFECOM_rttypeINTEGER_, "&i&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFTELL, "G77_ftell_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFSEEK, "G77_fseek_0", FFECOM_rttypeINTEGER_, "&i&i&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtGERROR, "G77_gerror_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtGETARG, "G77_getarg_0", FFECOM_rttypeVOID_, "&i&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtGETCWD, "G77_getcwd_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtGETGID, "G77_getgid_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtGETLOG, "G77_getlog_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtGETPID, "G77_getpid_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtGETUID, "G77_getuid_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtGETENV, "G77_getenv_0", FFECOM_rttypeVOID_, "&a&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtGMTIME, "G77_gmtime_0", FFECOM_rttypeVOID_, "&i&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtHOSTNM, "G77_hostnm_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtIABS, "i_abs", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtIARGC, "G77_iargc_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtIDATE, "G77_idate_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtIDIM, "i_dim", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtIDNINT, "i_dnnt", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtIERRNO, "G77_ierrno_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtINDEX, "i_indx", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtIRAND, "G77_irand_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtISIGN, "i_sign", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtISATTY, "G77_isatty_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtITIME, "G77_itime_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtKILL, "G77_kill_0", FFECOM_rttypeINTEGER_, "&i&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtLEN, "i_len", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtLGE, "l_ge", FFECOM_rttypeLOGICAL_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtLGT, "l_gt", FFECOM_rttypeLOGICAL_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtLINK, "G77_link_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtLLE, "l_le", FFECOM_rttypeLOGICAL_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtLLT, "l_lt", FFECOM_rttypeLOGICAL_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtLNBLNK, "G77_lnblnk_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtLSTAT, "G77_lstat_0", FFECOM_rttypeINTEGER_, "&a&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtLTIME, "G77_ltime_0", FFECOM_rttypeVOID_, "&i&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtMCLOCK, "G77_mclock_0", FFECOM_rttypeLONGINT_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtMOD, "i_mod", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtNINT, "i_nint", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtPERROR, "G77_perror_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtRAND, "G77_rand_0", FFECOM_rttypeREAL_F2C_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtRENAME, "G77_rename_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSECNDS, "G77_secnds_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSECOND, "G77_second_0", FFECOM_rttypeREAL_F2C_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSIGN, "r_sign", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_SIGNAL, "G77_signal_0", FFECOM_rttypeINTEGER_, "&i0", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSIN, "r_sin", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSINH, "r_sinh", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSLEEP, "G77_sleep_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSQRT, "r_sqrt", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSRAND, "G77_srand_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSTAT, "G77_stat_0", FFECOM_rttypeINTEGER_, "&a&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSYMLNK, "G77_symlnk_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSYSTEM, "G77_system_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSYSTEM_CLOCK, "system_clock_", FFECOM_rttypeVOID_, "&i&i&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtTAN, "r_tan", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtTANH, "r_tanh", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtTIME, "G77_time_0", FFECOM_rttypeLONGINT_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtTTYNAM, "G77_ttynam_0", FFECOM_rttypeCHARACTER_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtUNLINK, "G77_unlink_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtUMASK, "G77_umask_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtVXTIDATE, "G77_vxtidate_0", FFECOM_rttypeVOID_, "&i&i&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtVXTTIME, "G77_vxttime_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCDABS, "z_abs", FFECOM_rttypeDOUBLE_, "&e", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCDCOS, "z_cos", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtCDEXP, "z_exp", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtCDLOG, "z_log", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtDCONJG, "d_cnjg", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtCDSIN, "z_sin", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtCDSQRT, "z_sqrt", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtDIMAG, "d_imag", FFECOM_rttypeDOUBLE_, "&e", FALSE, FALSE)
+
+DEFGFRT (FFECOM_gfrtL_ACOS, "acos", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_ASIN, "asin", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_ATAN, "atan", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_ATAN2, "atan2", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_COS, "__builtin_cos", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_COSH, "cosh", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_ERF, "erf", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_ERFC, "erfc", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_EXP, "exp", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_FLOOR, "floor", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_LOG, "log", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_SIN, "__builtin_sin", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_SINH, "sinh", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_SQRT, "__builtin_fsqrt", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_TAN, "tan", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_TANH, "tanh", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+
+DEFGFRT (FFECOM_gfrtPOW_CI, "pow_ci", FFECOM_rttypeCOMPLEX_F2C_, "&c&i", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtPOW_DD, "pow_dd", FFECOM_rttypeDOUBLE_, "&d&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtPOW_DI, "pow_di", FFECOM_rttypeDOUBLE_, "&d&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtPOW_II, "pow_ii", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtPOW_QQ, "pow_qq", FFECOM_rttypeLONGINT_, "&j&j", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtPOW_RI, "pow_ri", FFECOM_rttypeREAL_F2C_, "&f&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtPOW_ZI, "pow_zi", FFECOM_rttypeDBLCMPLX_F2C_, "&e&i", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtPOW_ZZ, "pow_zz", FFECOM_rttypeDBLCMPLX_F2C_, "&e&e", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtDIV_CC, "c_div", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtDIV_ZZ, "z_div", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE)
diff --git a/gcc/f/com.c b/gcc/f/com.c
new file mode 100644
index 00000000000..65a6ea9c282
--- /dev/null
+++ b/gcc/f/com.c
@@ -0,0 +1,16225 @@
+/* com.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995-1997 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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):
+   int yes;
+   yes = suspend_momentary ();
+   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 ();
+   if (is_nested) resume_momentary (yes);
+
+   Everything Else:
+   int yes;
+   tree d;
+   tree init;
+   yes = suspend_momentary ();
+   // 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);
+   resume_momentary (yes);
+
+*/
+
+/* Include files. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#include "config.j"
+#include "flags.j"
+#include "rtl.j"
+#include "tree.j"
+#include "convert.j"
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+#define FFECOM_GCC_INCLUDE 1	/* Enable -I. */
+
+/* BEGIN stuff from gcc/cccp.c.  */
+
+/* The following symbols should be autoconfigured:
+	HAVE_FCNTL_H
+	HAVE_STDLIB_H
+	HAVE_SYS_TIME_H
+	HAVE_UNISTD_H
+	STDC_HEADERS
+	TIME_WITH_SYS_TIME
+   In the mean time, we'll get by with approximations based
+   on existing GCC configuration symbols.  */
+
+#ifdef POSIX
+# ifndef HAVE_STDLIB_H
+# define HAVE_STDLIB_H 1
+# endif
+# ifndef HAVE_UNISTD_H
+# define HAVE_UNISTD_H 1
+# endif
+# ifndef STDC_HEADERS
+# define STDC_HEADERS 1
+# endif
+#endif /* defined (POSIX) */
+
+#if defined (POSIX) || (defined (USG) && !defined (VMS))
+# ifndef HAVE_FCNTL_H
+# define HAVE_FCNTL_H 1
+# endif
+#endif
+
+#ifndef RLIMIT_STACK
+# include <time.h>
+#else
+# if TIME_WITH_SYS_TIME
+#  include <sys/time.h>
+#  include <time.h>
+# else
+#  if HAVE_SYS_TIME_H
+#   include <sys/time.h>
+#  else
+#   include <time.h>
+#  endif
+# endif
+# include <sys/resource.h>
+#endif
+
+#if HAVE_FCNTL_H
+# include <fcntl.h>
+#endif
+
+/* This defines "errno" properly for VMS, and gives us EACCES. */
+#include <errno.h>
+
+#if HAVE_STDLIB_H
+# include <stdlib.h>
+#else
+char *getenv ();
+#endif
+
+char *index ();
+char *rindex ();
+
+#if HAVE_UNISTD_H
+# include <unistd.h>
+#endif
+
+/* 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 */
+#ifdef __GNUC__
+#define BSTRING			/* VMS/GCC supplies the bstring routines */
+#endif /* __GNUC__ */
+#endif /* VMS */
+
+#ifndef O_RDONLY
+#define O_RDONLY 0
+#endif
+
+/* END stuff from gcc/cccp.c.  */
+
+#include "proj.h"
+#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"
+
+/* Externals defined here.  */
+
+#define FFECOM_FASTER_ARRAY_REFS 0	/* Generates faster code? */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+
+/* tree.h declares a bunch of stuff that it expects the front end to
+   define.  Here are the definitions, which in the C front end are
+   found in the file c-decl.c.  */
+
+tree integer_zero_node;
+tree integer_one_node;
+tree null_pointer_node;
+tree error_mark_node;
+tree void_type_node;
+tree integer_type_node;
+tree unsigned_type_node;
+tree char_type_node;
+tree current_function_decl;
+
+/* ~~tree.h SHOULD declare this, because toplev.c and dwarfout.c reference
+   it.  */
+
+char *language_string = "GNU F77";
+
+/* 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).  */
+
+static tree short_integer_type_node;
+tree long_integer_type_node;
+static tree long_long_integer_type_node;
+
+static tree short_unsigned_type_node;
+static tree long_unsigned_type_node;
+static tree long_long_unsigned_type_node;
+
+static tree unsigned_char_type_node;
+static tree signed_char_type_node;
+
+static tree float_type_node;
+static tree double_type_node;
+static tree complex_float_type_node;
+tree complex_double_type_node;
+static tree long_double_type_node;
+static tree complex_integer_type_node;
+static tree complex_long_double_type_node;
+
+tree string_type_node;
+
+static tree double_ftype_double;
+static tree float_ftype_float;
+static tree ldouble_ftype_ldouble;
+
+/* 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 tree ffecom_tree_fun_type_void;
+static tree ffecom_tree_ptr_to_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 tree ffecom_tree_fun_type[FFEINFO_basictype][FFEINFO_kindtype];
+static tree ffecom_tree_ptr_to_fun_type[FFEINFO_basictype][FFEINFO_kindtype];
+static tree ffecom_tree_subr_type;
+static tree ffecom_tree_ptr_to_subr_type;
+static tree ffecom_tree_blockdata_type;
+
+static tree ffecom_tree_xargc_;
+
+ffecomSymbol ffecom_symbol_null_
+=
+{
+  NULL_TREE,
+  NULL_TREE,
+  NULL_TREE,
+};
+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;
+tree ffecom_f2c_ptr_to_integer_type_node;
+tree ffecom_f2c_address_type_node;
+tree ffecom_f2c_real_type_node;
+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;
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+/* 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_rttypeINT_,		/* C's `int' type, for libF77/system_.c? */
+    FFECOM_rttypeINTEGER_,
+    FFECOM_rttypeLONGINT_,	/* C's `long long int' type. */
+    FFECOM_rttypeLOGICAL_,
+    FFECOM_rttypeREAL_F2C_,	/* f2c's `float' returned as `double'. */
+    FFECOM_rttypeREAL_GNU_,	/* `float' returned as such. */
+    FFECOM_rttypeCOMPLEX_F2C_,	/* f2c's `complex' returned via 1st arg. */
+    FFECOM_rttypeCOMPLEX_GNU_,	/* gcc's `complex float' returned as such. */
+    FFECOM_rttypeDOUBLE_,	/* C's `double' type. */
+    FFECOM_rttypeDOUBLEREAL_,
+    FFECOM_rttypeDBLCMPLX_F2C_,	/* f2c's `doublecomplex' returned via 1st arg. */
+    FFECOM_rttypeDBLCMPLX_GNU_,	/* gcc's `complex double' returned as such. */
+    FFECOM_rttypeCHARACTER_,	/* f2c `char *'/`ftnlen' pair. */
+    FFECOM_rttype_
+  } ffecomRttype_;
+
+/* Internal typedefs. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+typedef struct _ffecom_concat_list_ ffecomConcatList_;
+typedef struct _ffecom_temp_ *ffecomTemp_;
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+struct _ffecom_concat_list_
+  {
+    ffebld *exprs;
+    int count;
+    int max;
+    ffetargetCharacterSize minlen;
+    ffetargetCharacterSize maxlen;
+  };
+
+struct _ffecom_temp_
+  {
+    ffecomTemp_ next;
+    tree type;			/* Base type (w/o size/array applied). */
+    tree t;
+    ffetargetCharacterSize size;
+    int elements;
+    bool in_use;
+    bool auto_pop;
+  };
+
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+/* Static functions (internal). */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree ffecom_arglist_expr_ (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, 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);
+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);
+static void ffecom_char_args_ (tree *xitem, tree *length,
+			       ffebld expr);
+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, 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);
+static tree ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
+				    ffebld dest, bool *dest_used);
+static tree ffecom_expr_power_integer_ (ffebld left, ffebld right);
+static void ffecom_expr_transform_ (ffebld expr);
+static void ffecom_f2c_make_type_ (tree *type, int tcode, 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, char *text);
+static tree ffecom_get_external_identifier_ (ffesymbol s);
+static tree ffecom_get_identifier_ (char *text);
+static tree ffecom_gen_sfuncdef_ (ffesymbol s,
+				  ffeinfoBasictype bt,
+				  ffeinfoKindtype kt);
+static 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);
+#ifdef SOMEONE_GETS_DEBUG_SUPPORT_WORKING
+static void ffecom_member_phase2_ (ffestorag mst, ffestorag st);
+#endif
+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);
+static tree ffecom_type_localvar_ (ffesymbol s,
+				   ffeinfoBasictype bt,
+				   ffeinfoKindtype kt);
+static tree ffecom_type_namelist_ (void);
+#if 0
+static tree ffecom_type_permanent_copy_ (tree t);
+#endif
+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);
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+/* These are static functions that parallel those found in the C front
+   end and thus have the same names.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void bison_rule_compstmt_ (void);
+static void bison_rule_pushlevel_ (void);
+static tree builtin_function (char *name, tree type,
+			      enum built_in_function function_code,
+			      char *library_name);
+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 char *lang_printable_name (tree decl, char **kind);
+static tree lookup_name_current_level (tree name);
+static struct 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 tree storedecls (tree decls);
+static void store_parm_decls (int is_main_program);
+static tree start_decl (tree decl, bool is_top_level);
+static void start_function (tree name, tree type, int nested, int public);
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
+#if FFECOM_GCC_INCLUDE
+static void ffecom_file_ (char *name);
+static void ffecom_initialize_char_syntax_ (void);
+static void ffecom_close_include_ (FILE *f);
+static int ffecom_decode_include_option_ (char *spec);
+static FILE *ffecom_open_include_ (char *name, ffewhereLine l,
+				   ffewhereColumn c);
+#endif	/* FFECOM_GCC_INCLUDE */
+
+/* Static objects accessed by functions in this module. */
+
+static ffesymbol ffecom_primary_entry_ = NULL;
+static ffesymbol ffecom_nested_entry_ = NULL;
+static ffeinfoKind ffecom_primary_entry_kind_;
+static bool ffecom_primary_entry_is_proc_;
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree ffecom_outer_function_decl_;
+static tree ffecom_previous_function_decl_;
+static tree ffecom_which_entrypoint_decl_;
+static ffecomTemp_ ffecom_latest_temp_;
+static int ffecom_pending_calls_ = 0;
+static tree ffecom_float_zero_ = NULL_TREE;
+static tree ffecom_float_half_ = NULL_TREE;
+static tree ffecom_double_zero_ = NULL_TREE;
+static tree ffecom_double_half_ = NULL_TREE;
+static tree ffecom_func_result_;/* For functions. */
+static 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 tree ffecom_multi_type_node_;
+static tree ffecom_multi_retval_;
+static 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;
+
+/* Holds pointer-to-function expressions.  */
+
+static tree ffecom_gfrt_[FFECOM_gfrt]
+=
+{
+#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX) NULL_TREE,
+#include "com-rt.def"
+#undef DEFGFRT
+};
+
+/* Holds the external names of the functions.  */
+
+static char *ffecom_gfrt_name_[FFECOM_gfrt]
+=
+{
+#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX) NAME,
+#include "com-rt.def"
+#undef DEFGFRT
+};
+
+/* Whether the function returns.  */
+
+static bool ffecom_gfrt_volatile_[FFECOM_gfrt]
+=
+{
+#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX) VOLATILE,
+#include "com-rt.def"
+#undef DEFGFRT
+};
+
+/* Whether the function returns type complex.  */
+
+static bool ffecom_gfrt_complex_[FFECOM_gfrt]
+=
+{
+#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX) COMPLEX,
+#include "com-rt.def"
+#undef DEFGFRT
+};
+
+/* Type code for the function return value.  */
+
+static ffecomRttype_ ffecom_gfrt_type_[FFECOM_gfrt]
+=
+{
+#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX) TYPE,
+#include "com-rt.def"
+#undef DEFGFRT
+};
+
+/* String of codes for the function's arguments.  */
+
+static char *ffecom_gfrt_argstring_[FFECOM_gfrt]
+=
+{
+#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX) ARGS,
+#include "com-rt.def"
+#undef DEFGFRT
+};
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+/* Internal macros. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+
+/* We let tm.h override the types used here, to handle trivial differences
+   such as the choice of unsigned int or long unsigned int for size_t.
+   When machines start needing nontrivial differences in the size type,
+   it would be best to do something here to figure out automatically
+   from other information what type to use.  */
+
+/* NOTE: g77 currently doesn't use these; see setting of sizetype and
+   change that if you need to.	-- jcb 09/01/91. */
+
+#ifndef SIZE_TYPE
+#define SIZE_TYPE "long unsigned int"
+#endif
+
+#ifndef WCHAR_TYPE
+#define WCHAR_TYPE "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_start_compstmt_ bison_rule_pushlevel_
+#define ffecom_end_compstmt_ bison_rule_compstmt_
+
+/* 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 binding_level
+  {
+    /* 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 binding_level *level_chain;
+  };
+
+#define NULL_BINDING_LEVEL (struct binding_level *) NULL
+
+/* The binding level currently in effect.  */
+
+static struct binding_level *current_binding_level;
+
+/* A chain of binding_level structures awaiting reuse.  */
+
+static struct 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 binding_level *global_binding_level;
+
+/* Binding level structures are initialized by copying this one.  */
+
+static struct binding_level clear_binding_level
+=
+{NULL, NULL, NULL, NULL_BINDING_LEVEL};
+
+/* Language-dependent contents of an identifier.  */
+
+struct lang_identifier
+  {
+    struct tree_identifier ignore;
+    tree global_value, local_value, 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)
+
+/* 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 tree named_labels;
+
+/* A list of LABEL_DECLs from outer contexts that are currently shadowed.  */
+
+static tree shadowed_labels;
+
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+
+/* 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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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:
+      result = build1 (INDIRECT_REF, TREE_TYPE (ref),
+		       save_expr (build1 (ADDR_EXPR,
+					  build_pointer_type (TREE_TYPE (ref)),
+					  ref)));
+      break;
+
+
+    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);
+  TREE_RAISES (result) = TREE_RAISES (ref);
+
+  return result;
+}
+#endif
+
+/* A rip-off of gcc's convert.c convert_to_complex function,
+   reworked to handle complex implemented as C structures
+   (RECORD_TYPE with two fields, real and imaginary `r' and `i').  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_convert_to_complex_ (tree type, tree expr)
+{
+  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));
+}
+#endif
+
+/* Like gcc's convert(), but crashes if widening might happen.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_convert_narrow_ (type, expr)
+     tree type, expr;
+{
+  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);
+      assert (TYPE_PRECISION (type) <= TYPE_PRECISION (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);
+      assert (TYPE_PRECISION (TREE_TYPE (TYPE_FIELDS (type)))
+	      <= TYPE_PRECISION (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (e)))));
+      return fold (ffecom_convert_to_complex_ (type, e));
+    }
+
+  assert ("conversion to non-scalar type requested" == NULL);
+  return error_mark_node;
+}
+#endif
+
+/* Like gcc's convert(), but crashes if narrowing might happen.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_convert_widen_ (type, expr)
+     tree type, expr;
+{
+  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);
+      assert (TYPE_PRECISION (type) >= TYPE_PRECISION (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);
+      assert (TYPE_PRECISION (TREE_TYPE (TYPE_FIELDS (type)))
+	      >= TYPE_PRECISION (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (e)))));
+      return fold (ffecom_convert_to_complex_ (type, e));
+    }
+
+  assert ("conversion to non-scalar type requested" == NULL);
+  return error_mark_node;
+}
+#endif
+
+/* Handles making a COMPLEX type, either the standard
+   (but buggy?) gbe way, or the safer (but less elegant?)
+   f2c way.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_make_complex_type_ (tree subtype)
+{
+  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;
+}
+#endif
+
+/* Chooses either the gbe or the f2c way to build a
+   complex constant.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_build_complex_constant_ (tree type, tree realpart, tree imagpart)
+{
+  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, NULL_TREE, bothparts);
+    }
+  else
+    {
+      bothparts = build_complex (type, realpart, imagpart);
+    }
+
+  return bothparts;
+}
+#endif
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_arglist_expr_ (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;
+
+  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);
+	}
+    }
+
+  *plist = trail;
+
+  return list;
+}
+#endif
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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;
+}
+#endif
+
+/* 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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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 EXPON_EXPR:
+    case NEGATE_EXPR:
+    case MIN_EXPR:
+    case MAX_EXPR:
+    case ABS_EXPR:
+    case FFS_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_ANDTC_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 = size_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. */
+}
+#endif
+
+/* Check whether dest might overlap any of a list of arguments or is
+   in a COMMON area the callee might know about (and thus modify).  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static bool
+ffecom_args_overlapping_ (tree dest_tree, ffebld dest UNUSED,
+			  tree args, tree callee_commons,
+			  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;
+}
+#endif
+
+/* Build a string for a variable name as used by NAMELIST.  This means that
+   if we're using the f2c library, we build an uppercase string, since
+   f2c does this.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_build_f2c_string_ (int i, char *s)
+{
+  if (!ffe_is_f2c_library ())
+    return build_string (i, s);
+
+  {
+    char *tmp;
+    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 = ffesrc_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;
+  }
+}
+
+#endif
+/* Returns CALL_EXPR or equivalent with given type (pass NULL_TREE for
+   type to just get whatever the function returns), handling the
+   f2c value-returning convention, if required, by prepending
+   to the arglist a pointer to a temporary to receive the return value.	 */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_call_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex,
+	      tree type, tree args, tree dest_tree,
+	      ffebld dest, bool *dest_used, tree callee_commons,
+	      bool scalar_args)
+{
+  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 = ffecom_push_tempvar (ffecom_tree_type
+					 [FFEINFO_basictypeCOMPLEX][kt],
+					 FFETARGET_charactersizeNONE,
+					 -1, TRUE);
+	}
+      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;
+}
+#endif
+
+/* Given two arguments, transform them and make a call to the given
+   function via ffecom_call_.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_call_binop_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex,
+		    tree type, ffebld left, ffebld right,
+		    tree dest_tree, ffebld dest, bool *dest_used,
+		    tree callee_commons, bool scalar_args)
+{
+  tree left_tree;
+  tree right_tree;
+  tree left_length;
+  tree right_length;
+
+  ffecom_push_calltemps ();
+  left_tree = ffecom_arg_ptr_to_expr (left, &left_length);
+  right_tree = ffecom_arg_ptr_to_expr (right, &right_length);
+  ffecom_pop_calltemps ();
+
+  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);
+}
+#endif
+
+/* ffecom_char_args_ -- Return ptr/length args for char subexpression
+
+   tree ptr_arg;
+   tree length_arg;
+   ffebld expr;
+   ffecom_char_args_(&ptr_arg,&length_arg,expr);
+
+   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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffecom_char_args_ (tree *xitem, tree *length, ffebld expr)
+{
+  tree item;
+  tree high;
+  ffetargetCharacter1 val;
+
+  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;
+      high = build_int_2 (ffetarget_length_character1 (val),
+			  0);
+      TREE_TYPE (high) = ffecom_f2c_ftnlen_type_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
+	    (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:
+      {
+	ffebld dims[FFECOM_dimensionsMAX];
+	tree array;
+	int i;
+
+	ffecom_push_calltemps ();
+	ffecom_char_args_ (&item, length, ffebld_left (expr));
+	ffecom_pop_calltemps ();
+
+	if (item == error_mark_node || *length == error_mark_node)
+	  {
+	    item = *length = error_mark_node;
+	    break;
+	  }
+
+	/* Build up ARRAY_REFs in reverse order (since we're column major
+	   here in Fortran land). */
+
+	for (i = 0, expr = ffebld_right (expr);
+	     expr != NULL;
+	     expr = ffebld_trail (expr))
+	  dims[i++] = ffebld_head (expr);
+
+	for (--i, array = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item)));
+	     i >= 0;
+	     --i, array = TYPE_MAIN_VARIANT (TREE_TYPE (array)))
+	  {
+	    item = ffecom_2 (PLUS_EXPR, build_pointer_type (TREE_TYPE (array)),
+			     item,
+			     size_binop (MULT_EXPR,
+					 size_in_bytes (TREE_TYPE (array)),
+					 size_binop (MINUS_EXPR,
+						     ffecom_expr (dims[i]),
+				    TYPE_MIN_VALUE (TYPE_DOMAIN (array)))));
+	  }
+      }
+      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);
+
+	ffecom_push_calltemps ();
+	ffecom_char_args_ (&item, length, ffebld_left (expr));
+	ffecom_pop_calltemps ();
+
+	if (item == error_mark_node || *length == error_mark_node)
+	  {
+	    item = *length = error_mark_node;
+	    break;
+	  }
+
+	if (start == NULL)
+	  {
+	    if (end == NULL)
+	      ;
+	    else
+	      {
+		end_tree = convert (ffecom_f2c_ftnlen_type_node,
+				    ffecom_expr (end));
+
+		if (end_tree == error_mark_node)
+		  {
+		    item = *length = error_mark_node;
+		    break;
+		  }
+
+		*length = end_tree;
+	      }
+	  }
+	else
+	  {
+	    start_tree = convert (ffecom_f2c_ftnlen_type_node,
+				  ffecom_expr (start));
+
+	    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 = convert (ffecom_f2c_ftnlen_type_node,
+				    ffecom_expr (end));
+
+		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)
+	  size = 24;	/* ~~~~ Kludge alert!  This should someday be fixed. */
+
+	*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);
+	  }
+
+	assert (ffecom_pending_calls_ != 0);
+	tempvar = ffecom_push_tempvar (char_type_node, size, -1, TRUE);
+	tempvar = ffecom_1 (ADDR_EXPR,
+			    build_pointer_type (TREE_TYPE (tempvar)),
+			    tempvar);
+
+	ffecom_push_calltemps ();
+
+	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);
+
+	ffecom_pop_calltemps ();
+      }
+      break;
+
+    case FFEBLD_opCONVERT:
+
+      ffecom_push_calltemps ();
+      ffecom_char_args_ (&item, length, ffebld_left (expr));
+      ffecom_pop_calltemps ();
+
+      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;
+
+	  assert (ffecom_pending_calls_ != 0);
+	  tempvar = ffecom_push_tempvar (char_type_node,
+					 ffebld_size (expr), -1, TRUE);
+	  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);
+	  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;
+}
+#endif
+
+/* 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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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;
+
+  if ((tree_int_cst_sgn (TYPE_SIZE (type)) < 0)
+      || (!dummy && (TREE_INT_CST_HIGH (TYPE_SIZE (type)) != 0))
+      || 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;
+}
+#endif
+
+/* Builds a length argument (PARM_DECL).  Also wraps type in an array type
+   where the dimension info is (1:size) where <size> is ffesymbol_size(s) if
+   known, length_arg if not known (FFETARGET_charactersizeNONE).  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_char_enhance_arg_ (tree *xtype, ffesymbol s)
+{
+  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), 0);
+      else
+	tlen = ffecom_get_invented_identifier ("__g77_%s",
+					       "length", 0);
+      tlen = build_decl (PARM_DECL, tlen, ffecom_f2c_ftnlen_type_node);
+#if BUILT_FOR_270
+      DECL_ARTIFICIAL (tlen) = 1;
+#endif
+    }
+
+  if (sz == FFETARGET_charactersizeNONE)
+    {
+      assert (tlen != NULL_TREE);
+      highval = 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;
+}
+
+#endif
+/* 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.	 */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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:
+	      break;		/* ~~Do useful truncations here. */
+
+	    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;
+    }
+}
+
+#endif
+/* 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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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]));
+}
+
+#endif
+/* ffecom_concat_list_new_ -- Make list of concatenated string exprs
+
+   ffecomConcatList_ catlist;
+   ffebld expr;	 // Root expr of CHARACTER basictype.
+   ffetargetCharacterSize max;	// max chars to gather or _...NONE if no max
+   catlist = ffecom_concat_list_new_(expr,max);
+
+   Returns a flattened list of concatenated subexpressions given a
+   tree of such expressions.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static ffecomConcatList_
+ffecom_concat_list_new_ (ffebld expr, ffetargetCharacterSize max)
+{
+  ffecomConcatList_ catlist;
+
+  catlist.maxlen = catlist.minlen = catlist.max = catlist.count = 0;
+  return ffecom_concat_list_gather_ (catlist, expr, max);
+}
+
+#endif
+
+/* Provide some kind of useful info on member of aggregate area,
+   since current g77/gcc technology does not provide debug info
+   on these members.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffecom_debug_kludge_ (tree aggr, 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);
+}
+#endif
+
+/* 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).  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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. */
+  int yes;
+
+  /* c-parse.y indeed does call suspend_momentary and not only ignores the
+     return value, but also never calls resume_momentary, when starting an
+     outer function (see "fndef:", "setspecs:", and so on).  So g77 does the
+     same thing.  It shouldn't be a problem since start_function calls
+     temporary_allocation, but it might be necessary.  If it causes a problem
+     here, then maybe there's a bug lurking in gcc.  NOTE: This identical
+     comment appears twice in thist file.  */
+
+  suspend_momentary ();
+
+  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. */
+
+  yes = suspend_momentary ();
+
+  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", 0);
+
+      /* 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);
+
+  resume_momentary (yes);
+
+  store_parm_decls (0);
+
+  ffecom_start_compstmt_ ();
+
+  /* Make local var to hold return type for multi-type master fn. */
+
+  if (multi)
+    {
+      yes = suspend_momentary ();
+
+      multi_retval = ffecom_get_invented_identifier ("__g77_%s",
+						     "multi_retval", 0);
+      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);
+
+      resume_momentary (yes);
+    }
+  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)
+	  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)
+	  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);
+      }
+
+    clear_momentary ();
+  }
+
+  ffecom_end_compstmt_ ();
+
+  finish_function (0);
+
+  ffecom_doing_entry_ = FALSE;
+}
+
+#endif
+/* 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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_expr_ (ffebld expr, tree dest_tree,
+	      ffebld dest, bool *dest_used,
+	      bool assignp)
+{
+  tree item;
+  tree list;
+  tree args;
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+  tree t;
+  tree tree_type;
+  tree dt;			/* decl_tree for an ffesymbol. */
+  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));
+
+  switch (ffebld_op (expr))
+    {
+    case FFEBLD_opACCTER:
+      tree_type = ffecom_tree_type[bt][kt];
+      {
+	ffebitCount i;
+	ffebit bits = ffebld_accter_bits (expr);
+	ffetargetOffset source_offset = 0;
+	size_t size;
+	tree purpose;
+
+	size = ffetype_size (ffeinfo_type (bt, kt));
+
+	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)
+		      purpose = build_int_2 (source_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;
+	  }
+      }
+
+      item = build_int_2 (ffebld_accter_size (expr), 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, NULL_TREE, list);
+      TREE_CONSTANT (list) = 1;
+      TREE_STATIC (list) = 1;
+      return list;
+
+    case FFEBLD_opARRTER:
+      tree_type = ffecom_tree_type[bt][kt];
+      {
+	ffetargetOffset i;
+
+	list = item = NULL_TREE;
+	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)
+	      list = item = build_tree_list (NULL_TREE, t);
+	    else
+	      {
+		TREE_CHAIN (item) = build_tree_list (NULL_TREE, t);
+		item = TREE_CHAIN (item);
+	      }
+	  }
+      }
+
+      item = build_int_2 (ffebld_arrter_size (expr), 0);
+      TREE_TYPE (item) = ffecom_integer_type_node;
+      item
+	= build_array_type
+	  (tree_type,
+	   build_range_type (ffecom_integer_type_node,
+			     ffecom_integer_one_node,
+			     item));
+      list = build (CONSTRUCTOR, item, NULL_TREE, list);
+      TREE_CONSTANT (list) = 1;
+      TREE_STATIC (list) = 1;
+      return list;
+
+    case FFEBLD_opCONTER:
+      tree_type = ffecom_tree_type[bt][kt];
+      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)
+		{
+		  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:
+      {
+	ffebld dims[FFECOM_dimensionsMAX];
+#if FFECOM_FASTER_ARRAY_REFS
+	tree array;
+#endif
+	int i;
+
+#if FFECOM_FASTER_ARRAY_REFS
+	t = ffecom_ptr_to_expr (ffebld_left (expr));
+#else
+	t = ffecom_expr (ffebld_left (expr));
+#endif
+	if (t == error_mark_node)
+	  return t;
+
+	if ((ffeinfo_where (ffebld_info (expr)) == FFEINFO_whereFLEETING)
+	    && !mark_addressable (t))
+	  return error_mark_node;	/* Make sure non-const ref is to
+					   non-reg. */
+
+	/* Build up ARRAY_REFs in reverse order (since we're column major
+	   here in Fortran land). */
+
+	for (i = 0, expr = ffebld_right (expr);
+	     expr != NULL;
+	     expr = ffebld_trail (expr))
+	  dims[i++] = ffebld_head (expr);
+
+#if FFECOM_FASTER_ARRAY_REFS
+	for (--i, array = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (t)));
+	     i >= 0;
+	     --i, array = TYPE_MAIN_VARIANT (TREE_TYPE (array)))
+	  t = ffecom_2 (PLUS_EXPR,
+			build_pointer_type (TREE_TYPE (array)),
+			t,
+			size_binop (MULT_EXPR,
+				    size_in_bytes (TREE_TYPE (array)),
+				    size_binop (MINUS_EXPR,
+						ffecom_expr (dims[i]),
+						TYPE_MIN_VALUE (TYPE_DOMAIN (array)))));
+	t = ffecom_1 (INDIRECT_REF,
+		      TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (t))),
+		      t);
+#else
+	while (i > 0)
+	  t = ffecom_2 (ARRAY_REF,
+			TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (t))),
+			t,
+			ffecom_expr (dims[--i]));
+#endif
+
+	return t;
+      }
+
+    case FFEBLD_opUPLUS:
+      tree_type = ffecom_tree_type[bt][kt];
+      return ffecom_1 (NOP_EXPR, tree_type, ffecom_expr (ffebld_left (expr)));
+
+    case FFEBLD_opPAREN:	/* ~~~Make sure Fortran rules respected here */
+      tree_type = ffecom_tree_type[bt][kt];
+      return ffecom_1 (NOP_EXPR, tree_type, ffecom_expr (ffebld_left (expr)));
+
+    case FFEBLD_opUMINUS:
+      tree_type = ffecom_tree_type[bt][kt];
+      return ffecom_1 (NEGATE_EXPR, tree_type,
+		       ffecom_expr (ffebld_left (expr)));
+
+    case FFEBLD_opADD:
+      tree_type = ffecom_tree_type[bt][kt];
+      return ffecom_2 (PLUS_EXPR, tree_type,
+		       ffecom_expr (ffebld_left (expr)),
+		       ffecom_expr (ffebld_right (expr)));
+      break;
+
+    case FFEBLD_opSUBTRACT:
+      tree_type = ffecom_tree_type[bt][kt];
+      return ffecom_2 (MINUS_EXPR, tree_type,
+		       ffecom_expr (ffebld_left (expr)),
+		       ffecom_expr (ffebld_right (expr)));
+
+    case FFEBLD_opMULTIPLY:
+      tree_type = ffecom_tree_type[bt][kt];
+      return ffecom_2 (MULT_EXPR, tree_type,
+		       ffecom_expr (ffebld_left (expr)),
+		       ffecom_expr (ffebld_right (expr)));
+
+    case FFEBLD_opDIVIDE:
+      tree_type = ffecom_tree_type[bt][kt];
+      return
+	ffecom_tree_divide_ (tree_type,
+			     ffecom_expr (ffebld_left (expr)),
+			     ffecom_expr (ffebld_right (expr)),
+			     dest_tree, dest, dest_used);
+
+    case FFEBLD_opPOWER:
+      tree_type = ffecom_tree_type[bt][kt];
+      {
+	ffebld left = ffebld_left (expr);
+	ffebld right = ffebld_right (expr);
+	ffecomGfrt code;
+	ffeinfoKindtype rtkt;
+
+	switch (ffeinfo_basictype (ffebld_info (right)))
+	  {
+	  case FFEINFO_basictypeINTEGER:
+	    if (1 || optimize)
+	      {
+		item = ffecom_expr_power_integer_ (left, right);
+		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;
+		    rtkt = FFEINFO_kindtypeINTEGER4;
+		  }
+		else
+		  code = FFECOM_gfrtPOW_II;
+		break;
+
+	      case FFEINFO_basictypeREAL:
+		if (ffeinfo_kindtype (ffebld_info (left))
+		    == FFEINFO_kindtypeREAL1)
+		  code = FFECOM_gfrtPOW_RI;
+		else
+		  code = FFECOM_gfrtPOW_DI;
+		break;
+
+	      case FFEINFO_basictypeCOMPLEX:
+		if (ffeinfo_kindtype (ffebld_info (left))
+		    == FFEINFO_kindtypeREAL1)
+		  code = FFECOM_gfrtPOW_CI;	/* Overlapping result okay. */
+		else
+		  code = FFECOM_gfrtPOW_ZI;	/* Overlapping result okay. */
+		break;
+
+	      default:
+		assert ("bad pow_*i" == NULL);
+		code = FFECOM_gfrtPOW_CI;	/* Overlapping result okay. */
+		break;
+	      }
+	    if (ffeinfo_kindtype (ffebld_info (left)) != rtkt)
+	      left = ffeexpr_convert (left, NULL, NULL,
+				      FFEINFO_basictypeINTEGER,
+				      rtkt, 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);
+	    code = FFECOM_gfrtPOW_DD;
+	    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. */
+	    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);
+      }
+
+    case FFEBLD_opNOT:
+      tree_type = ffecom_tree_type[bt][kt];
+      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:
+      tree_type = ffecom_tree_type[bt][kt];
+      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);
+
+      ffecom_push_calltemps ();
+      if (ffesymbol_where (s) == FFEINFO_whereCONSTANT)
+	args = ffecom_list_expr (ffebld_right (expr));
+      else
+	args = ffecom_list_ptr_to_expr (ffebld_right (expr));
+      ffecom_pop_calltemps ();
+
+      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);
+      TREE_SIDE_EFFECTS (item) = 1;
+      return item;
+
+    case FFEBLD_opAND:
+      tree_type = ffecom_tree_type[bt][kt];
+      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:
+      tree_type = ffecom_tree_type[bt][kt];
+      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:
+      tree_type = ffecom_tree_type[bt][kt];
+      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:
+      tree_type = ffecom_tree_type[bt][kt];
+      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;
+
+      tree_type = ffecom_tree_type[bt][kt];
+      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:		/* :::::::::::::::::::: */
+
+      tree_type = ffecom_tree_type[bt][kt];
+      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:
+	  ffecom_push_calltemps ();	/* Even though we might not call. */
+
+	  {
+	    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)
+	      {
+		ffecom_pop_calltemps ();
+		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);
+		item = ffecom_2 (code, integer_type_node,
+				 item,
+				 convert (TREE_TYPE (item),
+					  integer_zero_node));
+	      }
+	    item = convert (tree_type, item);
+	  }
+
+	  ffecom_pop_calltemps ();
+	  return item;
+
+	default:
+	  assert ("relational bad basictype" == NULL);
+	  /* Fall through. */
+	case FFEINFO_basictypeANY:
+	  return error_mark_node;
+	}
+      break;
+
+    case FFEBLD_opPERCENT_LOC:
+      tree_type = ffecom_tree_type[bt][kt];
+      item = ffecom_arg_ptr_to_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
+}
+
+#endif
+/* Returns the tree that does the intrinsic invocation.
+
+   Note: this function applies only to intrinsics returning
+   CHARACTER*1 or non-CHARACTER results, and to intrinsic
+   subroutines.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
+			ffebld dest, bool *dest_used)
+{
+  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))),
+			   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))))
+				     ))
+		 );
+#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_))))),
+			   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)))))
+			   )
+		 );
+#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:
+      assert (ffecom_pending_calls_ != 0);
+      tempvar = ffecom_push_tempvar (char_type_node,
+				     1, -1, TRUE);
+      {
+	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)
+	gfrt = FFECOM_gfrtALOG10;
+      else if (kt == FFEINFO_kindtypeREAL2)
+	gfrt = FFECOM_gfrtDLOG10;
+      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)
+	gfrt = FFECOM_gfrtAMOD;
+      else if (kt == FFEINFO_kindtypeREAL2)
+	gfrt = FFECOM_gfrtDMOD;
+      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 true;
+	ffetargetLogical1 false;
+	tree true_tree;
+	tree false_tree;
+
+	ffetarget_logical1 (&true, TRUE);
+	ffetarget_logical1 (&false, FALSE);
+	if (true == 1)
+	  true_tree = convert (tree_type, integer_one_node);
+	else
+	  true_tree = convert (tree_type, build_int_2 (true, 0));
+	if (false == 0)
+	  false_tree = convert (tree_type, integer_zero_node);
+	else
+	  false_tree = convert (tree_type, build_int_2 (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))));
+#if !defined(TREE_SHIFT_FULLWIDTH) || !TREE_SHIFT_FULLWIDTH
+	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));
+#endif
+      }
+      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))));
+#if !defined(TREE_SHIFT_FULLWIDTH) || !TREE_SHIFT_FULLWIDTH
+	expr_tree
+	  = ffecom_3 (COND_EXPR, tree_type,
+		      ffecom_truth_value
+		      (ffecom_2 (NE_EXPR, integer_type_node,
+				 arg2_tree,
+				 TYPE_SIZE (uns_type))),
+		      expr_tree,
+		      convert (tree_type, integer_zero_node));
+#endif
+	/* 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);
+#if !defined(TREE_SHIFT_FULLWIDTH) || !TREE_SHIFT_FULLWIDTH
+	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));
+#endif
+	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;
+
+	ffecom_push_calltemps ();
+
+	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 (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)));
+
+	ffecom_pop_calltemps ();
+
+	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);
+#if !defined(TREE_SHIFT_FULLWIDTH) || !TREE_SHIFT_FULLWIDTH
+	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));
+#endif
+	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);
+#if !defined(TREE_SHIFT_FULLWIDTH) || !TREE_SHIFT_FULLWIDTH
+	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);
+#endif
+	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;
+
+	ffecom_push_calltemps ();
+
+	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_rw (arg3);
+	else
+	  arg3_tree = NULL_TREE;
+
+	ffecom_pop_calltemps ();
+
+	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);
+
+	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;
+
+	ffecom_push_calltemps ();
+
+	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_rw (arg3);
+	else
+	  arg3_tree = NULL_TREE;
+
+	ffecom_pop_calltemps ();
+
+	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);
+
+	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;
+
+	ffecom_push_calltemps ();
+
+	arg1_tree = ffecom_arg_ptr_to_expr (arg1, &arg1_len);
+
+	if (arg2 != NULL)
+	  arg2_tree = ffecom_expr_rw (arg2);
+	else
+	  arg2_tree = NULL_TREE;
+
+	ffecom_pop_calltemps ();
+
+	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);
+
+	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);
+
+    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;
+
+	ffecom_push_calltemps ();
+
+	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_rw (arg3);
+	else
+	  arg3_tree = NULL_TREE;
+
+	ffecom_pop_calltemps ();
+
+	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);
+	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;
+
+	ffecom_push_calltemps ();
+
+	arg1_tree = ffecom_arg_ptr_to_expr (arg1, &arg1_len);
+
+	arg2_tree = ffecom_ptr_to_expr (arg2);
+
+	if (arg3 != NULL)
+	  arg3_tree = ffecom_expr_rw (arg3);
+	else
+	  arg3_tree = NULL_TREE;
+
+	ffecom_pop_calltemps ();
+
+	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);
+	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;
+
+	ffecom_push_calltemps ();
+
+	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);
+	arg3_tree = ffecom_expr_rw (arg3);
+
+	ffecom_pop_calltemps ();
+
+	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);
+	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;
+
+	ffecom_push_calltemps ();
+
+	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_rw (arg3);
+
+	ffecom_pop_calltemps ();
+
+	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);
+	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;
+
+	ffecom_push_calltemps ();
+
+	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_rw (arg3);
+
+	ffecom_pop_calltemps ();
+
+	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);
+	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;
+
+	ffecom_push_calltemps ();
+
+	arg1_tree = ffecom_arg_ptr_to_expr (arg1, &arg1_len);
+
+	arg2_tree = convert (((gfrt == FFEINTRIN_impCTIME_subr) ?
+			      ffecom_f2c_longint_type_node :
+			      ffecom_f2c_integer_type_node),
+			     ffecom_expr (arg2));
+	arg2_tree = ffecom_1 (ADDR_EXPR,
+			      build_pointer_type (TREE_TYPE (arg2_tree)),
+			      arg2_tree);
+
+	ffecom_pop_calltemps ();
+
+	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);
+      }
+      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_doublereal_type_node),
+				  arg1_tree,
+				  dest_tree, dest, dest_used,
+				  NULL_TREE, TRUE);
+      }
+      return expr_tree;
+
+    case FFEINTRIN_impFTELL_subr:
+    case FFEINTRIN_impUMASK_subr:
+      {
+	tree arg1_tree;
+	tree arg2_tree;
+
+	ffecom_push_calltemps ();
+
+	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_rw (arg2);
+
+	ffecom_pop_calltemps ();
+
+	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);
+	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;
+
+	ffecom_push_calltemps ();
+
+	arg1_tree = ffecom_expr_rw (arg1);
+
+	ffecom_pop_calltemps ();
+
+	expr_tree
+	  = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+			  ffecom_gfrt_kindtype (gfrt),
+			  FALSE,
+			  NULL_TREE,
+			  NULL_TREE,
+			  NULL_TREE, NULL, NULL, NULL_TREE, TRUE);
+
+	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 arg2_tree;
+
+	ffecom_push_calltemps ();
+
+	arg1_tree = ffecom_expr_rw (arg1);
+
+	arg2_tree = ffecom_ptr_to_expr (arg2);
+
+	ffecom_pop_calltemps ();
+
+	expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+				  ffecom_gfrt_kindtype (gfrt),
+				  FALSE,
+				  NULL_TREE,
+				  build_tree_list (NULL_TREE, arg2_tree),
+				  NULL_TREE, NULL, NULL, NULL_TREE,
+				  TRUE);
+	expr_tree = ffecom_modify (NULL_TREE, arg1_tree,
+				   convert (TREE_TYPE (arg1_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_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! */
+
+  ffecom_push_calltemps ();
+  expr_tree = ffecom_arglist_expr_ (ffecom_gfrt_args_ (gfrt),
+				    ffebld_right (expr));
+  ffecom_pop_calltemps ();
+
+  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);
+
+  /**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 [-traditional].) //
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+// 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)
+
+*/
+}
+
+#endif
+/* For power (exponentiation) where right-hand operand is type INTEGER,
+   generate in-line code to do it the fast way (which, if the operand
+   is a constant, might just mean a series of multiplies).  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_expr_power_integer_ (ffebld left, ffebld right)
+{
+  tree l = ffecom_expr (left);
+  tree r = ffecom_expr (right);
+  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);
+	  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);
+	  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 basetypeof_l_is_int;
+    tree se;
+
+    basetypeof_l_is_int
+      = build_int_2 ((TREE_CODE (ltype) == INTEGER_TYPE), 0);
+
+    se = expand_start_stmt_expr ();
+    ffecom_push_calltemps ();
+
+    rtmp = ffecom_push_tempvar (rtype, FFETARGET_charactersizeNONE, -1,
+				TRUE);
+    ltmp = ffecom_push_tempvar (ltype, FFETARGET_charactersizeNONE, -1,
+				TRUE);
+    result = ffecom_push_tempvar (ltype, FFETARGET_charactersizeNONE, -1,
+				  TRUE);
+
+    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)));
+	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)));
+    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);
+
+    ffecom_pop_calltemps ();
+    result = expand_end_stmt_expr (se);
+    TREE_SIDE_EFFECTS (result) = 1;
+  }
+
+  return result;
+}
+
+#endif
+/* ffecom_expr_transform_ -- Transform symbols in expr
+
+   ffebld expr;	 // FFE expression.
+   ffecom_expr_transform_ (expr);
+
+   Recursive descent on expr while transforming any untransformed SYMTERs.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffecom_expr_transform_ (ffebld expr)
+{
+  tree t;
+  ffesymbol s;
+
+tail_recurse:			/* :::::::::::::::::::: */
+
+  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;
+}
+
+#endif
+/* Make a type based on info in live f2c.h file.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffecom_f2c_make_type_ (tree *type, int tcode, 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, 0),
+			*type));
+}
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+/* 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)
+	&& (TREE_INT_CST_LOW (TYPE_SIZE (t)) == size))
+      {
+	assert (code != -1);
+	ffecom_f2c_typecode_[bt][j] = code;
+	code = -1;
+      }
+}
+
+#endif
+/* Finish up globals after doing all program units in file
+
+   Need to handle only uninitialized COMMON areas.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static ffeglobal
+ffecom_finish_global_ (ffeglobal global)
+{
+  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. */
+
+  suspend_momentary ();
+
+  DECL_EXTERNAL (cbt) = 0;
+
+  /* Give the array a size now.  */
+
+  size = build_int_2 (ffeglobal_common_size (global), 0);
+
+  cbtype = TREE_TYPE (cbt);
+  TYPE_DOMAIN (cbtype) = build_range_type (integer_type_node,
+					   integer_one_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;
+}
+
+#endif
+/* Finish up any untransformed symbols.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static ffesymbol
+ffecom_finish_symbol_transform_ (ffesymbol s)
+{
+  if (s == NULL)
+    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)
+      && ((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))
+    {
+#ifdef SOMEONE_GETS_DEBUG_SUPPORT_WORKING
+      int yes = suspend_momentary ();
+
+      /* 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));
+
+      resume_momentary (yes);
+#endif
+    }
+
+  return s;
+}
+
+#endif
+/* Append underscore(s) to name before calling get_identifier.  "us"
+   is nonzero if the name already contains an underscore and thus
+   needs two underscores appended.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_get_appended_identifier_ (char us, 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;
+}
+
+#endif
+/* Decide whether to append underscore to name before calling
+   get_identifier.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_get_external_identifier_ (ffesymbol s)
+{
+  char us;
+  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)
+#if FFETARGET_isENFORCED_MAIN_NAME
+      || (strcmp (name, FFETARGET_nameENFORCED_NAME) == 0)
+#else
+      || (strcmp (name, FFETARGET_nameUNNAMED_MAIN) == 0)
+#endif
+      || (strcmp (name, FFETARGET_nameUNNAMED_BLOCK_DATA) == 0))
+    return get_identifier (name);
+
+  us = ffe_is_second_underscore ()
+    ? (strchr (name, '_') != NULL)
+      : 0;
+
+  return ffecom_get_appended_identifier_ (us, name);
+}
+
+#endif
+/* 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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_get_identifier_ (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);
+}
+
+#endif
+/* 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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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;
+  int yes;
+  int old_lineno = lineno;
+  char *old_input_filename = input_filename;
+
+  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);
+  lineno = 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;
+
+  yes = suspend_momentary ();
+
+  push_f_function_context ();
+
+  ffecom_push_calltemps ();
+
+  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.  */
+
+  yes = suspend_momentary ();
+
+  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", 0);
+
+      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);
+
+  resume_momentary (yes);
+
+  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_let_char_ (result, result_length, sz, expr);
+	  expand_null_return ();
+	}
+      else
+	expand_return (ffecom_modify (NULL_TREE,
+				      DECL_RESULT (current_function_decl),
+				      ffecom_expr (expr)));
+
+      clear_momentary ();
+    }
+
+  ffecom_end_compstmt_ ();
+
+  func = current_function_decl;
+  finish_function (1);
+
+  ffecom_pop_calltemps ();
+
+  pop_f_function_context ();
+
+  resume_momentary (yes);
+
+  recurse = FALSE;
+
+  lineno = old_lineno;
+  input_filename = old_input_filename;
+
+  ffecom_nested_entry_ = NULL;
+
+  return func;
+}
+
+#endif
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static char *
+ffecom_gfrt_args_ (ffecomGfrt ix)
+{
+  return ffecom_gfrt_argstring_[ix];
+}
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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]);
+}
+
+#endif
+/* Return initialize-to-zero expression for this VAR_DECL.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_init_zero_ (tree decl)
+{
+  tree init;
+  int incremental = TREE_STATIC (decl);
+  tree type = TREE_TYPE (decl);
+
+  if (incremental)
+    {
+      int momentary = suspend_momentary ();
+      push_obstacks_nochange ();
+      if (TREE_PERMANENT (decl))
+	end_temporary_allocation ();
+      make_decl_rtl (decl, NULL, TREE_PUBLIC (decl) ? 1 : 0);
+      assemble_variable (decl, TREE_PUBLIC (decl) ? 1 : 0, 0, 1);
+      pop_obstacks ();
+      resume_momentary (momentary);
+    }
+
+  push_momentary ();
+
+  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)
+    {
+      int momentary = suspend_momentary ();
+
+      init = build (CONSTRUCTOR, type, NULL_TREE, NULL_TREE);
+      TREE_CONSTANT (init) = 1;
+      TREE_STATIC (init) = 1;
+
+      resume_momentary (momentary);
+    }
+  else
+    {
+      int momentary = suspend_momentary ();
+
+      assemble_zeros (int_size_in_bytes (type));
+      init = error_mark_node;
+
+      resume_momentary (momentary);
+    }
+
+  pop_momentary_nofree ();
+
+  return init;
+}
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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_push_calltemps ();
+      ffecom_char_args_ (&expr_tree, &length_tree, arg);
+      ffecom_pop_calltemps ();
+
+      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;
+    }
+}
+
+#endif
+/* 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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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;
+}
+
+#endif
+/* ffecom_let_char_ -- Do assignment stuff for character type
+
+   tree dest_tree;  // destination (ADDR_EXPR)
+   tree dest_length;  // length (INT_CST/INDIRECT_REF(PARM_DECL))
+   ffetargetCharacterSize dest_size;  // length
+   ffebld source;  // source expression
+   ffecom_let_char_(dest_tree,dest_length,dest_size,source);
+
+   Generates code to do the assignment.	 Used by ordinary assignment
+   statement handler ffecom_let_stmt and by statement-function
+   handler to generate code for a statement function.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffecom_let_char_ (tree dest_tree, tree dest_length,
+		  ffetargetCharacterSize dest_size, ffebld source)
+{
+  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);
+      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);
+      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;
+
+    length_array
+      = lengths
+      = ffecom_push_tempvar (ffecom_f2c_ftnlen_type_node,
+			     FFETARGET_charactersizeNONE, count, TRUE);
+    item_array = items = ffecom_push_tempvar (ffecom_f2c_address_type_node,
+					      FFETARGET_charactersizeNONE,
+					      count, TRUE);
+
+    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);
+    TREE_SIDE_EFFECTS (expr_tree) = 1;
+
+    expand_expr_stmt (expr_tree);
+  }
+
+  ffecom_concat_list_kill_ (catlist);
+}
+
+#endif
+/* 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).  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffecom_make_gfrt_ (ffecomGfrt ix)
+{
+  tree t;
+  tree ttype;
+
+  push_obstacks_nochange ();
+  end_temporary_allocation ();
+
+  switch (ffecom_gfrt_type_[ix])
+    {
+    case FFECOM_rttypeVOID_:
+      ttype = void_type_node;
+      break;
+
+    case FFECOM_rttypeINT_:
+      ttype = integer_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 = ffecom_f2c_real_type_node;
+      break;
+
+    case FFECOM_rttypeREAL_GNU_:
+      ttype = ffecom_tree_type[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL1];
+      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_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_PUBLIC (t) = 1;
+  TREE_THIS_VOLATILE (t) = ffecom_gfrt_volatile_[ix] ? 1 : 0;
+
+  t = start_decl (t, TRUE);
+
+  finish_decl (t, NULL_TREE, TRUE);
+
+  resume_temporary_allocation ();
+  pop_obstacks ();
+
+  ffecom_gfrt_[ix] = t;
+}
+
+#endif
+/* Phase 1 pass over each member of a COMMON/EQUIVALENCE group.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffecom_member_phase1_ (ffestorag mst UNUSED, ffestorag st)
+{
+  ffesymbol s = ffestorag_symbol (st);
+
+  if (ffesymbol_namelisted (s))
+    ffecom_member_namelisted_ = TRUE;
+}
+
+#endif
+/* Phase 2 pass over each member of a COMMON/EQUIVALENCE group.  Declare
+   the member so debugger will see it.  Otherwise nobody should be
+   referencing the member.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#ifdef SOMEONE_GETS_DEBUG_SUPPORT_WORKING
+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;
+
+  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);
+}
+
+#endif
+#endif
+/* 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).  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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;
+}
+
+#endif
+/* ffecom_start_progunit_ -- Beginning of program unit
+
+   Does GNU back end stuff necessary to teach it about the start of its
+   equivalent of a Fortran program unit.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffecom_start_progunit_ ()
+{
+  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;
+  int old_lineno = lineno;
+  char *old_input_filename = input_filename;
+  int yes;
+
+  assert (fn != NULL);
+  assert (ffesymbol_hook (fn).decl_tree == NULL_TREE);
+
+  input_filename = ffesymbol_where_filename (fn);
+  lineno = ffesymbol_where_filelinenum (fn);
+
+  /* c-parse.y indeed does call suspend_momentary and not only ignores the
+     return value, but also never calls resume_momentary, when starting an
+     outer function (see "fndef:", "setspecs:", and so on).  So g77 does the
+     same thing.  It shouldn't be a problem since start_function calls
+     temporary_allocation, but it might be necessary.  If it causes a problem
+     here, then maybe there's a bug lurking in gcc.  NOTE: This identical
+     comment appears twice in thist file.  */
+
+  suspend_momentary ();
+
+  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),
+					 0);
+#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 */
+
+  if (!altentries
+      && ((g = ffesymbol_global (fn)) != NULL)
+      && ((ffeglobal_type (g) == gt)
+	  || (ffeglobal_type (g) == egt)))
+    {
+      ffeglobal_set_hook (g, current_function_decl);
+    }
+
+  yes = suspend_momentary ();
+
+  /* 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",
+						      0),
+		      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", 0);
+
+      /* 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);
+    }
+
+  resume_momentary (yes);
+
+  store_parm_decls (main_program ? 1 : 0);
+
+  ffecom_start_compstmt_ ();
+
+  lineno = old_lineno;
+  input_filename = old_input_filename;
+
+  /* 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_);
+}
+
+#endif
+/* 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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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;
+  int yes;
+  int old_lineno = lineno;
+  char *old_input_filename = input_filename;
+
+  if (ffesymbol_sfdummyparent (s) == NULL)
+    {
+      input_filename = ffesymbol_where_filename (s);
+      lineno = ffesymbol_where_filelinenum (s);
+    }
+  else
+    {
+      ffesymbol sf = ffesymbol_sfdummyparent (s);
+
+      input_filename = ffesymbol_where_filename (sf);
+      lineno = 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);
+#if BUILT_FOR_270
+	  DECL_ARTIFICIAL (t) = 1;
+#endif
+	  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;
+	    }
+
+	  push_obstacks_nochange ();
+	  end_temporary_allocation ();
+
+	  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);
+
+	  resume_temporary_allocation ();
+	  pop_obstacks ();
+
+	  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;
+
+	    if ((st != NULL)
+		&& (ffestorag_size (st) == 0))
+	      {
+		t = error_mark_node;
+		break;
+	      }
+
+	    yes = suspend_momentary ();
+	    type = ffecom_type_localvar_ (s, bt, kt);
+	    resume_momentary (yes);
+
+	    if (type == error_mark_node)
+	      {
+		t = error_mark_node;
+		break;
+	      }
+
+	    if ((st != NULL)
+		&& (ffestorag_parent (st) != NULL))
+	      {			/* Child of EQUIVALENCE parent. */
+		ffestorag est;
+		tree et;
+		int yes;
+		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);
+
+		yes = suspend_momentary ();
+
+		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);
+
+		addr = TRUE;
+
+		resume_momentary (yes);
+	      }
+	    else
+	      {
+		tree initexpr;
+		bool init = ffesymbol_is_init (s);
+
+		yes = suspend_momentary ();
+
+		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))
+		  {
+		    tree size_tree;
+
+		    size_tree = size_binop (CEIL_DIV_EXPR,
+					    DECL_SIZE (t),
+					    size_int (BITS_PER_UNIT));
+		    assert (TREE_INT_CST_HIGH (size_tree) == 0);
+		    assert (TREE_INT_CST_LOW (size_tree) == ffestorag_size (st));
+		  }
+
+		resume_momentary (yes);
+	      }
+	  }
+	  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))
+	    {
+	      yes = suspend_momentary ();
+
+	      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]);
+
+	      resume_momentary (yes);
+	      break;
+	    }
+
+	  yes = suspend_momentary ();
+
+	  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;
+
+	  resume_momentary (yes);
+	  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)).  */
+		  high = convert (TREE_TYPE (low),
+				  TYPE_MAX_VALUE (TREE_TYPE (low)));
+		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)
+			|| (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 (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 (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);
+#if BUILT_FOR_270
+	    DECL_ARTIFICIAL (t) = 1;
+#endif
+
+	    /* If this arg is present in every entry point's list of
+	       dummy args, then we're done.  */
+
+	    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;
+	    int yes;
+
+	    cs = ffesymbol_common (s);	/* The COMMON area itself.  */
+	    if (st != NULL)	/* Else not laid out. */
+	      {
+		ffecom_transform_common_ (cs);
+		st = ffesymbol_storage (s);
+	      }
+
+	    yes = suspend_momentary ();
+
+	    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;
+
+		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));
+		t = ffecom_2 (PLUS_EXPR, TREE_TYPE (t),
+			      t,
+			      build_int_2 (offset, 0));
+		t = convert (build_pointer_type (type),
+			     t);
+
+		addr = TRUE;
+	      }
+
+	    resume_momentary (yes);
+	  }
+	  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;
+	    }
+
+	  push_obstacks_nochange ();
+	  end_temporary_allocation ();
+
+	  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);
+
+	  resume_temporary_allocation ();
+	  pop_obstacks ();
+
+	  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);
+#if BUILT_FOR_270
+	  DECL_ARTIFICIAL (t) = 1;
+#endif
+	  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;
+	    }
+
+	  push_obstacks_nochange ();
+	  end_temporary_allocation ();
+
+	  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, FALSE);
+	  finish_decl (t, NULL_TREE, FALSE);
+
+	  if ((g != NULL)
+	      && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR)
+		  || (ffeglobal_type (g) == FFEGLOBAL_typeEXT)))
+	    ffeglobal_set_hook (g, t);
+
+	  resume_temporary_allocation ();
+	  pop_obstacks ();
+
+	  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);
+#if BUILT_FOR_270
+	  DECL_ARTIFICIAL (t) = 1;
+#endif
+	  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_);
+
+	  push_obstacks_nochange ();
+	  end_temporary_allocation ();
+
+	  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);
+
+	  resume_temporary_allocation ();
+	  pop_obstacks ();
+
+	  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;
+
+  lineno = old_lineno;
+  input_filename = old_input_filename;
+
+  return s;
+}
+
+#endif
+/* 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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static ffesymbol
+ffecom_sym_transform_assign_ (ffesymbol s)
+{
+  tree t;			/* Transformed thingy. */
+  int yes;
+  int old_lineno = lineno;
+  char *old_input_filename = input_filename;
+
+  if (ffesymbol_sfdummyparent (s) == NULL)
+    {
+      input_filename = ffesymbol_where_filename (s);
+      lineno = ffesymbol_where_filelinenum (s);
+    }
+  else
+    {
+      ffesymbol sf = ffesymbol_sfdummyparent (s);
+
+      input_filename = ffesymbol_where_filename (sf);
+      lineno = ffesymbol_where_filelinenum (sf);
+    }
+
+  assert (!ffecom_transform_only_dummies_);
+
+  yes = suspend_momentary ();
+
+  t = build_decl (VAR_DECL,
+		  ffecom_get_invented_identifier ("__g77_ASSIGN_%s",
+						   ffesymbol_text (s),
+						   0),
+		  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);
+
+  resume_momentary (yes);
+
+  ffesymbol_hook (s).assign_tree = t;
+
+  lineno = old_lineno;
+  input_filename = old_input_filename;
+
+  return s;
+}
+
+#endif
+/* 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).  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffecom_transform_common_ (ffesymbol s)
+{
+  ffestorag st = ffesymbol_storage (s);
+  ffeglobal g = ffesymbol_global (s);
+  tree cbt;
+  tree cbtype;
+  tree init;
+  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)))
+    return;
+
+  /* Process inits.  */
+
+  if (is_init)
+    {
+      if (ffestorag_init (st) != NULL)
+	{
+	  init = ffecom_expr (ffestorag_init (st));
+	  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;
+
+  push_obstacks_nochange ();
+  end_temporary_allocation ();
+
+  /* cbtype must be permanently allocated!  */
+
+  if (init)
+    cbtype = build_array_type (char_type_node,
+			       build_range_type (integer_type_node,
+						 integer_one_node,
+						 build_int_2
+						 (ffeglobal_common_size (g),
+						  0)));
+  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;
+
+  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)
+    {
+      tree size_tree;
+
+      assert (DECL_SIZE (cbt) != NULL_TREE);
+      assert (TREE_CODE (DECL_SIZE (cbt)) == INTEGER_CST);
+      size_tree = size_binop (CEIL_DIV_EXPR,
+			      DECL_SIZE (cbt),
+			      size_int (BITS_PER_UNIT));
+      assert (TREE_INT_CST_HIGH (size_tree) == 0);
+      assert (TREE_INT_CST_LOW (size_tree) == ffeglobal_common_size (g));
+    }
+
+  ffeglobal_set_hook (g, cbt);
+
+  ffestorag_set_hook (st, cbt);
+
+  resume_temporary_allocation ();
+  pop_obstacks ();
+}
+
+#endif
+/* Make master area for local EQUIVALENCE.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffecom_transform_equiv_ (ffestorag eqst)
+{
+  tree eqt;
+  tree eqtype;
+  tree init;
+  tree high;
+  bool is_init = ffestorag_is_init (eqst);
+  int yes;
+
+  assert (eqst != NULL);
+
+  eqt = ffestorag_hook (eqst);
+
+  if (eqt != NULL_TREE)
+    return;
+
+  /* Process inits.  */
+
+  if (is_init)
+    {
+      if (ffestorag_init (eqst) != NULL)
+	{
+	  init = ffecom_expr (ffestorag_init (eqst));
+	  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);
+
+  yes = suspend_momentary ();
+
+  high = build_int_2 (ffestorag_size (eqst), 0);
+  TREE_TYPE (high) = ffecom_integer_type_node;
+
+  eqtype = build_array_type (char_type_node,
+			     build_range_type (ffecom_integer_type_node,
+					       ffecom_integer_one_node,
+					       high));
+
+  eqt = build_decl (VAR_DECL,
+		    ffecom_get_invented_identifier ("__g77_equiv_%s",
+						    ffesymbol_text
+						    (ffestorag_symbol
+						     (eqst)),
+						    0),
+		    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;
+  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 this shows up as a debug symbol, which is not normally
+     the case for invented identifiers.  */
+
+  DECL_IGNORED_P (eqt) = 0;
+
+  /* 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;
+
+  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 ());
+
+  {
+    tree size_tree;
+
+    size_tree = size_binop (CEIL_DIV_EXPR,
+			    DECL_SIZE (eqt),
+			    size_int (BITS_PER_UNIT));
+    assert (TREE_INT_CST_HIGH (size_tree) == 0);
+    assert (TREE_INT_CST_LOW (size_tree) == ffestorag_size (eqst));
+  }
+
+  ffestorag_set_hook (eqst, eqt);
+
+#ifdef SOMEONE_GETS_DEBUG_SUPPORT_WORKING
+  ffestorag_drive (ffestorag_list_equivs (eqst),
+		   &ffecom_member_phase2_,
+		   eqst);
+#endif
+
+  resume_momentary (yes);
+}
+
+#endif
+/* Implement NAMELIST in back end.  See f2c/format.c for more info.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_transform_namelist_ (ffesymbol s)
+{
+  tree nmlt;
+  tree nmltype = ffecom_type_namelist_ ();
+  tree nmlinits;
+  tree nameinit;
+  tree varsinit;
+  tree nvarsinit;
+  tree field;
+  tree high;
+  int yes;
+  int i;
+  static int mynumber = 0;
+
+  yes = suspend_momentary ();
+
+  nmlt = build_decl (VAR_DECL,
+		     ffecom_get_invented_identifier ("__g77_namelist_%d",
+						     NULL, 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, NULL_TREE, nmlinits);
+  TREE_CONSTANT (nmlinits) = 1;
+  TREE_STATIC (nmlinits) = 1;
+
+  finish_decl (nmlt, nmlinits, FALSE);
+
+  nmlt = ffecom_1 (ADDR_EXPR, build_pointer_type (nmltype), nmlt);
+
+  resume_momentary (yes);
+
+  return nmlt;
+}
+
+#endif
+
+/* A subroutine of ffecom_tree_canonize_ref_.  The incoming tree is
+   analyzed on the assumption it is calculating a pointer to be
+   indirected through.  It must return the proper decl and offset,
+   taking into account different units of measurements for offsets.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffecom_tree_canonize_ptr_ (tree *decl, tree *offset,
+			   tree t)
+{
+  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 = size_binop (PLUS_EXPR,
+				*offset,
+				TREE_OPERAND (t, 1));
+	  /* Convert offset (presumably in bytes) into canonical units
+	     (presumably bits).  */
+	  *offset = size_binop (MULT_EXPR,
+				*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 = size_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 = size_zero_node;
+	  break;
+	}
+      /* Fall through.  */
+    default:
+      /* Not a COMMON reference, so an unrecognized pattern.  */
+      *decl = error_mark_node;
+      break;
+    }
+}
+#endif
+
+/* Given a tree that is possibly intended for use as an lvalue, return
+   information representing a canonical view of that tree as a decl, an
+   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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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 EXPON_EXPR:
+    case NEGATE_EXPR:
+    case MIN_EXPR:
+    case MAX_EXPR:
+    case ABS_EXPR:
+    case FFS_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_ANDTC_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 = size_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;
+
+	*offset = size_binop (MULT_EXPR,
+			      TYPE_SIZE (TREE_TYPE (TREE_TYPE (array))),
+			      size_binop (MINUS_EXPR,
+					  element,
+					  TYPE_MIN_VALUE
+					  (TYPE_DOMAIN
+					   (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;
+    }
+}
+#endif
+
+/* Do divide operation appropriate to type of operands.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_tree_divide_ (tree tree_type, tree left, tree right,
+		     tree dest_tree, ffebld dest, bool *dest_used)
+{
+  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:
+      {
+	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);
+      }
+      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);
+      }
+      break;
+
+    default:
+      return ffecom_2 (RDIV_EXPR, tree_type,
+		       left,
+		       right);
+    }
+}
+
+#endif
+/* ffecom_type_localvar_ -- Build type info for non-dummy variable
+
+   tree type;
+   ffesymbol s;	 // the variable's symbol
+   ffeinfoBasictype bt;	 // it's basictype
+   ffeinfoKindtype kt; // it's kindtype
+
+   type = ffecom_type_localvar_(s,bt,kt);
+
+   Handles static arrays, CHARACTER type, etc.	*/
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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;
+}
+
+#endif
+/* Build Namelist type.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_type_namelist_ ()
+{
+  static tree type = NULL_TREE;
+
+  if (type == NULL_TREE)
+    {
+      static tree namefield, varsfield, nvarsfield;
+      tree vardesctype;
+
+      vardesctype = ffecom_type_vardesc_ ();
+
+      push_obstacks_nochange ();
+      end_temporary_allocation ();
+
+      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);
+
+      resume_temporary_allocation ();
+      pop_obstacks ();
+    }
+
+  return type;
+}
+
+#endif
+
+/* Make a copy of a type, assuming caller has switched to the permanent
+   obstacks and that the type is for an aggregate (array) initializer.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC && 0	/* Not used now. */
+static tree
+ffecom_type_permanent_copy_ (tree t)
+{
+  tree domain;
+  tree max;
+
+  assert (TREE_TYPE (t) != NULL_TREE);
+
+  domain = TYPE_DOMAIN (t);
+
+  assert (TREE_CODE (t) == ARRAY_TYPE);
+  assert (TREE_PERMANENT (TREE_TYPE (t)));
+  assert (TREE_PERMANENT (TREE_TYPE (domain)));
+  assert (TREE_PERMANENT (TYPE_MIN_VALUE (domain)));
+
+  max = TYPE_MAX_VALUE (domain);
+  if (!TREE_PERMANENT (max))
+    {
+      assert (TREE_CODE (max) == INTEGER_CST);
+
+      max = build_int_2 (TREE_INT_CST_LOW (max), TREE_INT_CST_HIGH (max));
+      TREE_TYPE (max) = TREE_TYPE (TYPE_MIN_VALUE (domain));
+    }
+
+  return build_array_type (TREE_TYPE (t),
+			   build_range_type (TREE_TYPE (domain),
+					     TYPE_MIN_VALUE (domain),
+					     max));
+}
+#endif
+
+/* Build Vardesc type.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_type_vardesc_ ()
+{
+  static tree type = NULL_TREE;
+  static tree namefield, addrfield, dimsfield, typefield;
+
+  if (type == NULL_TREE)
+    {
+      push_obstacks_nochange ();
+      end_temporary_allocation ();
+
+      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_ftnlen_type_node);
+      typefield = ffecom_decl_field (type, dimsfield, "type",
+				     integer_type_node);
+
+      TYPE_FIELDS (type) = namefield;
+      layout_type (type);
+
+      resume_temporary_allocation ();
+      pop_obstacks ();
+    }
+
+  return type;
+}
+
+#endif
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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;
+      int yes;
+      static int mynumber = 0;
+
+      yes = suspend_momentary ();
+
+      var = build_decl (VAR_DECL,
+			ffecom_get_invented_identifier ("__g77_vardesc_%d",
+							NULL, 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, NULL_TREE, varinits);
+      TREE_CONSTANT (varinits) = 1;
+      TREE_STATIC (varinits) = 1;
+
+      finish_decl (var, varinits, FALSE);
+
+      var = ffecom_1 (ADDR_EXPR, build_pointer_type (vardesctype), var);
+
+      resume_momentary (yes);
+
+      ffesymbol_hook (s).vardesc_tree = var;
+    }
+
+  return ffesymbol_hook (s).vardesc_tree;
+}
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_vardesc_array_ (ffesymbol s)
+{
+  ffebld b;
+  tree list;
+  tree item = NULL_TREE;
+  tree var;
+  int i;
+  int yes;
+  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);
+	}
+    }
+
+  yes = suspend_momentary ();
+
+  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, NULL_TREE, list);
+  TREE_CONSTANT (list) = 1;
+  TREE_STATIC (list) = 1;
+
+  var = ffecom_get_invented_identifier ("__g77_vardesc_array_%d", NULL,
+					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);
+
+  resume_momentary (yes);
+
+  return var;
+}
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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;
+    int yes;
+    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;
+
+    yes = suspend_momentary ();
+
+    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, NULL_TREE, numdim);
+    TREE_CONSTANT (list) = 1;
+    TREE_STATIC (list) = 1;
+
+    var = ffecom_get_invented_identifier ("__g77_dims_%d", NULL,
+					  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);
+
+    resume_momentary (yes);
+
+    return var;
+  }
+}
+
+#endif
+/* Essentially does a "fold (build1 (code, type, node))" while checking
+   for certain housekeeping things.
+
+   NOTE: for building an ADDR_EXPR around a FUNCTION_DECL, use
+   ffecom_1_fn instead.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_1 (enum tree_code code, tree type, tree node)
+{
+  tree item;
+
+  if ((node == error_mark_node)
+      || (type == error_mark_node))
+    return error_mark_node;
+
+  if (code == ADDR_EXPR)
+    {
+      if (!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;
+  return fold (item);
+}
+#endif
+
+/* 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).  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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);
+}
+#endif
+
+/* Essentially does a "fold (build (code, type, node1, node2))" while
+   checking for certain housekeeping things.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_2 (enum tree_code code, tree type, tree node1,
+	  tree node2)
+{
+  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, NULL_TREE, 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);
+}
+
+#endif
+/* 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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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;
+}
+
+#endif
+/* 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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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);
+}
+
+#endif
+
+/* Essentially does a "fold (build (code, type, node1, node2))" while
+   checking for certain housekeeping things.  Always sets
+   TREE_SIDE_EFFECTS.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_2s (enum tree_code code, tree type, tree node1,
+	   tree node2)
+{
+  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);
+}
+
+#endif
+/* Essentially does a "fold (build (code, type, node1, node2, node3))" while
+   checking for certain housekeeping things.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_3 (enum tree_code code, tree type, tree node1,
+	  tree node2, tree node3)
+{
+  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);
+}
+
+#endif
+/* Essentially does a "fold (build (code, type, node1, node2, node3))" while
+   checking for certain housekeeping things.  Always sets
+   TREE_SIDE_EFFECTS.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_3s (enum tree_code code, tree type, tree node1,
+	   tree node2, tree node3)
+{
+  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);
+}
+
+#endif
+/* 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).  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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);
+}
+
+#endif
+/* 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 FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_arg_ptr_to_expr (ffebld expr, tree *length)
+{
+  tree item;
+  tree ign_length;
+  ffecomConcatList_ catlist;
+
+  *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);
+	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));
+      ign_length = NULL_TREE;
+      length = &ign_length;
+      expr = ffebld_left (expr);
+      break;
+
+    case FFEBLD_opPERCENT_DESCR:
+      switch (ffeinfo_basictype (ffebld_info (expr)))
+	{
+#ifdef PASS_HOLLERITH_BY_DESCRIPTOR
+	case FFEINFO_basictypeHOLLERITH:
+#endif
+	case FFEINFO_basictypeCHARACTER:
+	  break;		/* Passed by descriptor anyway. */
+
+	default:
+	  item = ffecom_ptr_to_expr (expr);
+	  if (item != error_mark_node)
+	    *length = TYPE_SIZE (TREE_TYPE (TREE_TYPE (item)));
+	  break;
+	}
+      break;
+
+    default:
+      break;
+    }
+
+#ifdef PASS_HOLLERITH_BY_DESCRIPTOR
+  if (ffeinfo_basictype (ffebld_info (expr)) == FFEINFO_basictypeHOLLERITH)
+    {				/* Pass Hollerith by descriptor. */
+      ffetargetHollerith h;
+
+      assert (ffebld_op (expr) == FFEBLD_opCONTER);
+      h = ffebld_cu_val_hollerith (ffebld_constant_union
+				   (ffebld_conter (expr)));
+      *length
+	= build_int_2 (h.length, 0);
+      TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node;
+    }
+#endif
+
+  if (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeCHARACTER)
+    return ffecom_ptr_to_expr (expr);
+
+  assert (ffeinfo_kindtype (ffebld_info (expr))
+	  == FFEINFO_kindtypeCHARACTER1);
+
+  catlist = ffecom_concat_list_new_ (expr, FFETARGET_charactersizeNONE);
+  switch (ffecom_concat_list_count_ (catlist))
+    {
+    case 0:			/* Shouldn't happen, but in case it does... */
+      *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. */
+      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;
+
+    length_array
+      = lengths
+      = ffecom_push_tempvar (ffecom_f2c_ftnlen_type_node,
+			     FFETARGET_charactersizeNONE, count, TRUE);
+    item_array
+      = items
+      = ffecom_push_tempvar (ffecom_f2c_address_type_node,
+			     FFETARGET_charactersizeNONE, count, TRUE);
+
+    known_length = ffecom_f2c_ftnlen_zero_node;
+
+    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);
+	    *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);
+	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);
+      }
+
+    sz = ffecom_concat_list_maxlen_ (catlist);
+    assert (sz != FFETARGET_charactersizeNONE);
+
+    temporary = ffecom_push_tempvar (char_type_node,
+				     sz, -1, TRUE);
+    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);
+    TREE_SIDE_EFFECTS (item) = 1;
+    item = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (temporary),
+		     item,
+		     temporary);
+
+    *length = known_length;
+  }
+
+  ffecom_concat_list_kill_ (catlist);
+  assert (item != NULL_TREE);
+  return item;
+}
+
+#endif
+/* ffecom_call_gfrt -- Generate call to run-time function
+
+   tree expr;
+   expr = ffecom_call_gfrt(FFECOM_gfrtSTOPNIL,NULL_TREE);
+
+   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).	*/
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_call_gfrt (ffecomGfrt ix, tree args)
+{
+  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);
+}
+#endif
+
+/* ffecom_constantunion -- Transform constant-union to tree
+
+   ffebldConstantUnion cu;  // the constant to transform
+   ffeinfoBasictype bt;	 // its basic type
+   ffeinfoKindtype kt;	// its kind type
+   tree tree_type;  // ffecom_tree_type[bt][kt]
+   ffecom_constantunion(&cu,bt,kt,tree_type);  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt,
+		      ffeinfoKindtype kt, tree tree_type)
+{
+  tree item;
+
+  switch (bt)
+    {
+    case FFEINFO_basictypeINTEGER:
+      {
+	int val;
+
+	switch (kt)
+	  {
+#if FFETARGET_okINTEGER1
+	  case FFEINFO_kindtypeINTEGER1:
+	    val = ffebld_cu_val_integer1 (*cu);
+	    break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	  case FFEINFO_kindtypeINTEGER2:
+	    val = ffebld_cu_val_integer2 (*cu);
+	    break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	  case FFEINFO_kindtypeINTEGER3:
+	    val = ffebld_cu_val_integer3 (*cu);
+	    break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	  case FFEINFO_kindtypeINTEGER4:
+	    val = ffebld_cu_val_integer4 (*cu);
+	    break;
+#endif
+
+	  default:
+	    assert ("bad INTEGER 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_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
+
+#if FFETARGET_okREAL4
+	  case FFEINFO_kindtypeREAL4:
+	    val = ffetarget_value_real4 (ffebld_cu_val_real4 (*cu));
+	    break;
+#endif
+
+	  default:
+	    assert ("bad REAL constant kind type" == NULL);
+	    /* Fall through. */
+	  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
+
+#if FFETARGET_okCOMPLEX4
+	  case FFEINFO_kindtypeREAL4:
+	    real = ffetarget_value_real4 (ffebld_cu_val_complex4 (*cu).real);
+	    imag = ffetarget_value_real4 (ffebld_cu_val_complex4 (*cu).imaginary);
+	    break;
+#endif
+
+	  default:
+	    assert ("bad REAL constant kind type" == NULL);
+	    /* Fall through. */
+	  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;
+}
+
+#endif
+
+/* Handy way to make a field in a struct/union.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_decl_field (tree context, tree prevfield,
+		   char *name, tree type)
+{
+  tree field;
+
+  field = build_decl (FIELD_DECL, get_identifier (name), type);
+  DECL_CONTEXT (field) = context;
+  DECL_FRAME_SIZE (field) = 0;
+  if (prevfield != NULL_TREE)
+    TREE_CHAIN (prevfield) = field;
+
+  return field;
+}
+
+#endif
+
+void
+ffecom_close_include (FILE *f)
+{
+#if FFECOM_GCC_INCLUDE
+  ffecom_close_include_ (f);
+#endif
+}
+
+int
+ffecom_decode_include_option (char *spec)
+{
+#if FFECOM_GCC_INCLUDE
+  return ffecom_decode_include_option_ (spec);
+#else
+  return 1;
+#endif
+}
+
+/* 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 ()
+{
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffebld item;
+#endif
+
+  if (ffe_is_ffedebug ())
+    fprintf (dmpout, "; end_stmt_transition\n");
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffecom_list_blockdata_ = NULL;
+  ffecom_list_common_ = NULL;
+#endif
+
+  ffesymbol_drive (ffecom_sym_end_transition);
+  if (ffe_is_ffedebug ())
+    {
+      ffestorag_report ();
+      ffesymbol_report_all ();
+    }
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffecom_start_progunit_ ();
+
+  for (item = ffecom_list_blockdata_;
+       item != NULL;
+       item = ffebld_trail (item))
+    {
+      ffebld callee;
+      ffesymbol s;
+      tree dt;
+      tree t;
+      tree var;
+      int yes;
+      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;
+	}
+
+      yes = suspend_momentary ();
+
+      dt = build_pointer_type (TREE_TYPE (t));
+
+      var = build_decl (VAR_DECL,
+			ffecom_get_invented_identifier ("__g77_forceload_%d",
+							NULL, 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);
+
+      resume_momentary (yes);
+    }
+
+  /* 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;
+#endif
+}
+
+/* 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 ()
+{
+  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 ();
+      ffesymbol_report_all ();
+    }
+
+  if (inhibited)
+    ffebad_set_inhibit (TRUE);
+}
+
+/* ffecom_expand_let_stmt -- Compile let (assignment) statement
+
+   ffebld dest;
+   ffebld source;
+   ffecom_expand_let_stmt(dest,source);
+
+   Convert dest and source using ffecom_expr, then join them
+   with an ASSIGN op and pass the whole thing to expand_expr_stmt.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+void
+ffecom_expand_let_stmt (ffebld dest, ffebld source)
+{
+  tree dest_tree;
+  tree dest_length;
+  tree source_tree;
+  tree expr_tree;
+
+  if (ffeinfo_basictype (ffebld_info (dest)) != FFEINFO_basictypeCHARACTER)
+    {
+      bool dest_used;
+
+      dest_tree = ffecom_expr_rw (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);
+      else
+	{
+	  source_tree = ffecom_expr (source);
+	  dest_used = FALSE;
+	}
+      if (source_tree == error_mark_node)
+	return;
+
+      if (dest_used)
+	expr_tree = source_tree;
+      else
+	expr_tree = ffecom_2s (MODIFY_EXPR, void_type_node,
+			       dest_tree,
+			       source_tree);
+
+      expand_expr_stmt (expr_tree);
+      return;
+    }
+
+  ffecom_push_calltemps ();
+  ffecom_char_args_ (&dest_tree, &dest_length, dest);
+  ffecom_let_char_ (dest_tree, dest_length, ffebld_size_known (dest),
+		    source);
+  ffecom_pop_calltemps ();
+}
+
+#endif
+/* 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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_expr (ffebld expr)
+{
+  return ffecom_expr_ (expr, NULL_TREE, NULL, NULL,
+		       FALSE);
+}
+
+#endif
+/* Like ffecom_expr, but return tree usable for assigned GOTO or FORMAT.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_expr_assign (ffebld expr)
+{
+  return ffecom_expr_ (expr, NULL_TREE, NULL, NULL,
+		       TRUE);
+}
+
+#endif
+/* Like ffecom_expr_rw, but return tree usable for ASSIGN.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_expr_assign_w (ffebld expr)
+{
+  return ffecom_expr_ (expr, NULL_TREE, NULL, NULL,
+		       TRUE);
+}
+
+#endif
+/* Transform expr for use as into read/write tree and stabilize the
+   reference.  Not for use on CHARACTER expressions.
+
+   Recursive descent on expr while making corresponding tree nodes and
+   attaching type info and such.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_expr_rw (ffebld expr)
+{
+  assert (expr != NULL);
+
+  return stabilize_reference (ffecom_expr (expr));
+}
+
+#endif
+/* Do global stuff.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+void
+ffecom_finish_compile ()
+{
+  assert (ffecom_outer_function_decl_ == NULL_TREE);
+  assert (current_function_decl == NULL_TREE);
+
+  ffeglobal_drive (ffecom_finish_global_);
+}
+
+#endif
+/* Public entry point for front end to access finish_decl.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+void
+ffecom_finish_decl (tree decl, tree init, bool is_top_level)
+{
+  assert (!is_top_level);
+  finish_decl (decl, init, FALSE);
+}
+
+#endif
+/* Finish a program unit.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+void
+ffecom_finish_progunit ()
+{
+  ffecom_end_compstmt_ ();
+
+  ffecom_previous_function_decl_ = current_function_decl;
+  ffecom_which_entrypoint_decl_ = NULL_TREE;
+
+  finish_function (0);
+}
+
+#endif
+/* Wrapper for get_identifier.  pattern is like "...%s...", text is
+   inserted into final name in place of "%s", or if text is NULL,
+   pattern is like "...%d..." and text form of number is inserted
+   in place of "%d".  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_get_invented_identifier (char *pattern, char *text, int number)
+{
+  tree decl;
+  char *nam;
+  mallocSize lenlen;
+  char space[66];
+
+  if (text == NULL)
+    lenlen = strlen (pattern) + 20;
+  else
+    lenlen = strlen (pattern) + strlen (text) - 1;
+  if (lenlen > ARRAY_SIZE (space))
+    nam = malloc_new_ks (malloc_pool_image (), pattern, lenlen);
+  else
+    nam = &space[0];
+  if (text == NULL)
+    sprintf (&nam[0], pattern, number);
+  else
+    sprintf (&nam[0], pattern, text);
+  decl = get_identifier (nam);
+  if (lenlen > ARRAY_SIZE (space))
+    malloc_kill_ks (malloc_pool_image (), nam, lenlen);
+
+  IDENTIFIER_INVENTED (decl) = 1;
+
+  return decl;
+}
+
+ffeinfoBasictype
+ffecom_gfrt_basictype (ffecomGfrt gfrt)
+{
+  assert (gfrt < FFECOM_gfrt);
+
+  switch (ffecom_gfrt_type_[gfrt])
+    {
+    case FFECOM_rttypeVOID_:
+      return FFEINFO_basictypeNONE;
+
+    case FFECOM_rttypeINT_:
+      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_:
+      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_:
+      return FFEINFO_kindtypeNONE;
+
+    case FFECOM_rttypeINT_:
+      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_:
+      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 ()
+{
+  tree endlink;
+  int i;
+  int j;
+  tree t;
+  tree field;
+  ffetype type;
+  ffetype base_type;
+
+  /* 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 char names[][12]
+	=
+      {"bar", "bletch", "foo", "foobar"};
+      char *name;
+      unsigned long ul;
+      double fl;
+
+      name = bsearch ("foo", &names[0], ARRAY_SIZE (names), sizeof (names[0]),
+		      (int (*)()) strcmp);
+      if (name != (char *) &names[2])
+	{
+	  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 ();
+	}
+    }
+
+#if FFECOM_GCC_INCLUDE
+  ffecom_initialize_char_syntax_ ();
+#endif
+
+  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;
+  pushlevel (0);		/* make the binding_level structure for
+				   global names */
+  global_binding_level = current_binding_level;
+
+  /* Define `int' and `char' first so that dbx will output them first.  */
+
+  integer_type_node = make_signed_type (INT_TYPE_SIZE);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("int"),
+			integer_type_node));
+
+  char_type_node = make_unsigned_type (CHAR_TYPE_SIZE);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("char"),
+			char_type_node));
+
+  long_integer_type_node = make_signed_type (LONG_TYPE_SIZE);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("long int"),
+			long_integer_type_node));
+
+  unsigned_type_node = make_unsigned_type (INT_TYPE_SIZE);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned int"),
+			unsigned_type_node));
+
+  long_unsigned_type_node = make_unsigned_type (LONG_TYPE_SIZE);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("long unsigned int"),
+			long_unsigned_type_node));
+
+  long_long_integer_type_node = make_signed_type (LONG_LONG_TYPE_SIZE);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("long long int"),
+			long_long_integer_type_node));
+
+  long_long_unsigned_type_node = make_unsigned_type (LONG_LONG_TYPE_SIZE);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("long long unsigned int"),
+			long_long_unsigned_type_node));
+
+  sizetype
+    = TREE_TYPE (IDENTIFIER_GLOBAL_VALUE (get_identifier (SIZE_TYPE)));
+
+  TREE_TYPE (TYPE_SIZE (integer_type_node)) = sizetype;
+  TREE_TYPE (TYPE_SIZE (char_type_node)) = sizetype;
+  TREE_TYPE (TYPE_SIZE (unsigned_type_node)) = sizetype;
+  TREE_TYPE (TYPE_SIZE (long_unsigned_type_node)) = sizetype;
+  TREE_TYPE (TYPE_SIZE (long_integer_type_node)) = sizetype;
+  TREE_TYPE (TYPE_SIZE (long_long_integer_type_node)) = sizetype;
+  TREE_TYPE (TYPE_SIZE (long_long_unsigned_type_node)) = sizetype;
+
+  error_mark_node = make_node (ERROR_MARK);
+  TREE_TYPE (error_mark_node) = error_mark_node;
+
+  short_integer_type_node = make_signed_type (SHORT_TYPE_SIZE);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("short int"),
+			short_integer_type_node));
+
+  short_unsigned_type_node = make_unsigned_type (SHORT_TYPE_SIZE);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("short unsigned int"),
+			short_unsigned_type_node));
+
+  /* Define both `signed char' and `unsigned char'.  */
+  signed_char_type_node = make_signed_type (CHAR_TYPE_SIZE);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("signed char"),
+			signed_char_type_node));
+
+  unsigned_char_type_node = make_unsigned_type (CHAR_TYPE_SIZE);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned char"),
+			unsigned_char_type_node));
+
+  float_type_node = make_node (REAL_TYPE);
+  TYPE_PRECISION (float_type_node) = FLOAT_TYPE_SIZE;
+  layout_type (float_type_node);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("float"),
+			float_type_node));
+
+  double_type_node = make_node (REAL_TYPE);
+  TYPE_PRECISION (double_type_node) = DOUBLE_TYPE_SIZE;
+  layout_type (double_type_node);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("double"),
+			double_type_node));
+
+  long_double_type_node = make_node (REAL_TYPE);
+  TYPE_PRECISION (long_double_type_node) = LONG_DOUBLE_TYPE_SIZE;
+  layout_type (long_double_type_node);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("long double"),
+			long_double_type_node));
+
+  complex_integer_type_node = ffecom_make_complex_type_ (integer_type_node);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("complex int"),
+			complex_integer_type_node));
+
+  complex_float_type_node = ffecom_make_complex_type_ (float_type_node);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("complex float"),
+			complex_float_type_node));
+
+  complex_double_type_node = ffecom_make_complex_type_ (double_type_node);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("complex double"),
+			complex_double_type_node));
+
+  complex_long_double_type_node = ffecom_make_complex_type_ (long_double_type_node);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("complex long double"),
+			complex_long_double_type_node));
+
+  integer_zero_node = build_int_2 (0, 0);
+  TREE_TYPE (integer_zero_node) = integer_type_node;
+  integer_one_node = build_int_2 (1, 0);
+  TREE_TYPE (integer_one_node) = integer_type_node;
+
+  size_zero_node = build_int_2 (0, 0);
+  TREE_TYPE (size_zero_node) = sizetype;
+  size_one_node = build_int_2 (1, 0);
+  TREE_TYPE (size_one_node) = sizetype;
+
+  void_type_node = make_node (VOID_TYPE);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("void"),
+			void_type_node));
+  layout_type (void_type_node);	/* Uses integer_zero_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;
+
+  null_pointer_node = build_int_2 (0, 0);
+  TREE_TYPE (null_pointer_node) = build_pointer_type (void_type_node);
+  layout_type (TREE_TYPE (null_pointer_node));
+
+  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);
+
+  float_ftype_float
+    = build_function_type (float_type_node,
+			   tree_cons (NULL_TREE, float_type_node, endlink));
+
+  double_ftype_double
+    = build_function_type (double_type_node,
+			   tree_cons (NULL_TREE, double_type_node, endlink));
+
+  ldouble_ftype_ldouble
+    = build_function_type (long_double_type_node,
+			   tree_cons (NULL_TREE, long_double_type_node,
+				      endlink));
+
+  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);
+  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 ("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_);
+  type = ffetype_new ();
+  ffetype_set_kind (ffeinfo_type (FFEINFO_basictypeINTEGER,
+				  FFEINFO_kindtypeINTEGERDEFAULT),
+		    7, type);
+
+  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);
+  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_FRAME_SIZE (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_sqrtf", float_ftype_float,
+		    BUILT_IN_FSQRT, "sqrtf");
+  builtin_function ("__builtin_fsqrt", double_ftype_double,
+		    BUILT_IN_FSQRT, "sqrt");
+  builtin_function ("__builtin_sqrtl", ldouble_ftype_ldouble,
+		    BUILT_IN_FSQRT, "sqrtl");
+  builtin_function ("__builtin_sinf", float_ftype_float,
+		    BUILT_IN_SIN, "sinf");
+  builtin_function ("__builtin_sin", double_ftype_double,
+		    BUILT_IN_SIN, "sin");
+  builtin_function ("__builtin_sinl", ldouble_ftype_ldouble,
+		    BUILT_IN_SIN, "sinl");
+  builtin_function ("__builtin_cosf", float_ftype_float,
+		    BUILT_IN_COS, "cosf");
+  builtin_function ("__builtin_cos", double_ftype_double,
+		    BUILT_IN_COS, "cos");
+  builtin_function ("__builtin_cosl", ldouble_ftype_ldouble,
+		    BUILT_IN_COS, "cosl");
+
+#if BUILT_FOR_270
+  pedantic_lvalues = FALSE;
+#endif
+
+  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);
+  {
+    REAL_VALUE_TYPE point_5;
+
+#ifdef REAL_ARITHMETIC
+    REAL_ARITHMETIC (point_5, RDIV_EXPR, dconst1, dconst2);
+#else
+    point_5 = .5;
+#endif
+    ffecom_float_half_ = build_real (float_type_node, point_5);
+    ffecom_double_half_ = build_real (double_type_node, point_5);
+  }
+
+  /* Do "extern int xargc;".  */
+
+  ffecom_tree_xargc_ = build_decl (VAR_DECL,
+				   get_identifier ("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.  g77 should");
+      warning ("support non-32-bit machines better as of version 0.6.");
+    }
+#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
+}
+
+#endif
+/* ffecom_init_2 -- Initialize
+
+   ffecom_init_2();  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+void
+ffecom_init_2 ()
+{
+  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_latest_temp_ = NULL;
+  ffecom_primary_entry_ = NULL;
+  ffecom_is_altreturning_ = FALSE;
+  ffecom_func_result_ = NULL_TREE;
+  ffecom_multi_retval_ = NULL_TREE;
+}
+
+#endif
+/* 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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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)
+    {
+      *plist
+	= build_tree_list (NULL_TREE, ffecom_arg_expr (ffebld_head (expr),
+						       &length));
+      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;
+}
+
+#endif
+/* 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).  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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)
+    {
+      *plist
+	= build_tree_list (NULL_TREE,
+			   ffecom_arg_ptr_to_expr (ffebld_head (expr),
+						   &length));
+      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;
+}
+
+#endif
+/* Obtain gcc's LABEL_DECL tree for label.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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:
+	  push_obstacks_nochange ();
+	  end_temporary_allocation ();
+
+	  glabel = build_decl (VAR_DECL,
+			       ffecom_get_invented_identifier
+			       ("__g77_format_%d", NULL,
+				(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) = 0;
+	  DECL_INITIAL (glabel) = NULL;
+	  make_decl_rtl (glabel, NULL, 0);
+	  expand_decl (glabel);
+
+	  resume_temporary_allocation ();
+	  pop_obstacks ();
+
+	  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;
+}
+
+#endif
+/* Stabilizes the arguments.  Don't use this if the lhs and rhs come from
+   a single source specification (as in the fourth argument of MVBITS).
+   If the type is NULL_TREE, the type of lhs is used to make the type of
+   the MODIFY_EXPR.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_modify (tree newtype, tree lhs,
+	       tree rhs)
+{
+  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);
+}
+
+#endif
+
+/* Register source file name.  */
+
+void
+ffecom_file (char *name)
+{
+#if FFECOM_GCC_INCLUDE
+  ffecom_file_ (name);
+#endif
+}
+
+/* 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 0 && FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffetargetOffset size;		/* The size of the entity. */
+#endif
+
+  if (ffestorag_init (st) == NULL)
+    {
+      init = ffestorag_accretion (st);
+      assert (init != NULL);
+      ffestorag_set_accretion (st, NULL);
+      ffestorag_set_accretes (st, 0);
+
+#if 0 && FFECOM_targetCURRENT == FFECOM_targetGCC
+      /* For GNU backend, just turn ACCTER into ARRTER and proceed. */
+      size = ffebld_accter_size (init);
+      ffebit_kill (ffebld_accter_bits (init));
+      ffebld_set_op (init, FFEBLD_opARRTER);
+      ffebld_set_arrter (init, ffebld_accter (init));
+      ffebld_arrter_set_size (init, size);
+#endif
+
+#if FFECOM_TWOPASS
+      ffestorag_set_init (st, init);
+#endif
+    }
+#if FFECOM_ONEPASS
+  else
+    init = ffestorag_init (st);
+#endif
+
+#if FFECOM_ONEPASS		/* Process the inits, wipe 'em out. */
+  ffestorag_set_init (st, ffebld_new_any ());
+
+  if (ffebld_op (init) == FFEBLD_opANY)
+    return;			/* Oh, we already did this! */
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  {
+    ffesymbol s;
+
+    if (ffestorag_symbol (st) != NULL)
+      s = ffestorag_symbol (st);
+    else
+      s = ffestorag_typesymbol (st);
+
+    fprintf (dmpout, "= initialize_storage \"%s\" ",
+	     (s != NULL) ? ffesymbol_text (s) : "(unnamed)");
+    ffebld_dump (init);
+    fputc ('\n', dmpout);
+  }
+#endif
+
+#endif /* if FFECOM_ONEPASS */
+}
+
+/* ffecom_notify_init_symbol -- A symbol is now fully init'ed
+
+   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 0 && FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffetargetOffset size;		/* The size of the entity. */
+#endif
+
+  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);
+
+#if 0 && FFECOM_targetCURRENT == FFECOM_targetGCC
+      /* For GNU backend, just turn ACCTER into ARRTER and proceed. */
+      size = ffebld_accter_size (init);
+      ffebit_kill (ffebld_accter_bits (init));
+      ffebld_set_op (init, FFEBLD_opARRTER);
+      ffebld_set_arrter (init, ffebld_accter (init));
+      ffebld_arrter_set_size (init, size);
+#endif
+
+#if FFECOM_TWOPASS
+      ffesymbol_set_init (s, init);
+#endif
+    }
+#if FFECOM_ONEPASS
+  else
+    init = ffesymbol_init (s);
+#endif
+
+#if FFECOM_ONEPASS
+  ffesymbol_set_init (s, ffebld_new_any ());
+
+  if (ffebld_op (init) == FFEBLD_opANY)
+    return;			/* Oh, we already did this! */
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "= initialize_symbol \"%s\" ", ffesymbol_text (s));
+  ffebld_dump (init);
+  fputc ('\n', dmpout);
+#endif
+
+#endif /* if FFECOM_ONEPASS */
+}
+
+/* ffecom_notify_primary_entry -- Learn which is the primary entry point
+
+   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_targetCURRENT == FFECOM_targetGCC
+  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;
+	    }
+	}
+    }
+#endif
+}
+
+FILE *
+ffecom_open_include (char *name, ffewhereLine l, ffewhereColumn c)
+{
+#if FFECOM_GCC_INCLUDE
+  return ffecom_open_include_ (name, l, c);
+#else
+  return fopen (name, "r");
+#endif
+}
+
+/* Clean up after making automatically popped call-arg temps.
+
+   Call this in pairs with push_calltemps around calls to
+   ffecom_arg_ptr_to_expr if the latter might use temporaries.
+   Any temporaries made within the outermost sequence of
+   push_calltemps and pop_calltemps, that are marked as "auto-pop"
+   meaning they won't be explicitly popped (freed), are popped
+   at this point so they can be reused later.
+
+   NOTE: when called by ffecom_gen_sfuncdef_, ffecom_pending_calls_
+   should come in == 1, and all of the in-use auto-pop temps
+   should have DECL_CONTEXT (temp->t) == current_function_decl.
+   Moreover, these temps should _never_ be re-used in future
+   calls to ffecom_push_tempvar -- since current_function_decl will
+   never be the same again.
+
+   SO, it could be a minor win in terms of compile time to just
+   strip these temps off the list.  That is, if the above assumptions
+   are correct, just remove from the list of temps any temp
+   that is both in-use and has DECL_CONTEXT (temp->t)
+   == current_function_decl, when called from ffecom_gen_sfuncdef_.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+void
+ffecom_pop_calltemps ()
+{
+  ffecomTemp_ temp;
+
+  assert (ffecom_pending_calls_ > 0);
+
+  if (--ffecom_pending_calls_ == 0)
+    for (temp = ffecom_latest_temp_; temp != NULL; temp = temp->next)
+      if (temp->auto_pop)
+	temp->in_use = FALSE;
+}
+
+#endif
+/* Mark latest temp with given tree as no longer in use.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+void
+ffecom_pop_tempvar (tree t)
+{
+  ffecomTemp_ temp;
+
+  for (temp = ffecom_latest_temp_; temp != NULL; temp = temp->next)
+    if (temp->in_use && (temp->t == t))
+      {
+	assert (!temp->auto_pop);
+	temp->in_use = FALSE;
+	return;
+      }
+    else
+      assert (temp->t != t);
+
+  assert ("couldn't ffecom_pop_tempvar!" != NULL);
+}
+
+#endif
+/* 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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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:
+      {
+	ffebld dims[FFECOM_dimensionsMAX];
+	tree array;
+	int i;
+
+	item = ffecom_ptr_to_expr (ffebld_left (expr));
+
+	if (item == error_mark_node)
+	  return item;
+
+	if ((ffeinfo_where (ffebld_info (expr)) == FFEINFO_whereFLEETING)
+	    && !mark_addressable (item))
+	  return error_mark_node;	/* Make sure non-const ref is to
+					   non-reg. */
+
+	/* Build up ARRAY_REFs in reverse order (since we're column major
+	   here in Fortran land). */
+
+	for (i = 0, expr = ffebld_right (expr);
+	     expr != NULL;
+	     expr = ffebld_trail (expr))
+	  dims[i++] = ffebld_head (expr);
+
+	for (--i, array = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item)));
+	     i >= 0;
+	     --i, array = TYPE_MAIN_VARIANT (TREE_TYPE (array)))
+	  {
+	    item
+	      = ffecom_2 (PLUS_EXPR,
+			  build_pointer_type (TREE_TYPE (array)),
+			  item,
+			  size_binop (MULT_EXPR,
+				      size_in_bytes (TREE_TYPE (array)),
+				      size_binop (MINUS_EXPR,
+						  ffecom_expr (dims[i]),
+						  TYPE_MIN_VALUE (TYPE_DOMAIN (array)))));
+	  }
+      }
+      return item;
+
+    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:
+      assert (ffecom_pending_calls_ > 0);
+
+      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;
+}
+
+#endif
+/* Prepare to make call-arg temps.
+
+   Call this in pairs with pop_calltemps around calls to
+   ffecom_arg_ptr_to_expr if the latter might use temporaries.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+void
+ffecom_push_calltemps ()
+{
+  ffecom_pending_calls_++;
+}
+
+#endif
+/* Obtain a temp var with given data type.
+
+   Returns a VAR_DECL tree of a currently (that is, at the current
+   statement being compiled) not in use and having the given data type,
+   making a new one if necessary.  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.  auto_pop is TRUE if
+   ffecom_pop_tempvar won't be called, meaning temp will be freed
+   when #pending calls goes to zero.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_push_tempvar (tree type, ffetargetCharacterSize size, int elements,
+		     bool auto_pop)
+{
+  ffecomTemp_ temp;
+  int yes;
+  tree t;
+  static int mynumber;
+
+  assert (!auto_pop || (ffecom_pending_calls_ > 0));
+
+  if (type == error_mark_node)
+    return error_mark_node;
+
+  for (temp = ffecom_latest_temp_; temp != NULL; temp = temp->next)
+    {
+      if (temp->in_use
+	  || (temp->type != type)
+	  || (temp->size != size)
+	  || (temp->elements != elements)
+	  || (DECL_CONTEXT (temp->t) != current_function_decl))
+	continue;
+
+      temp->in_use = TRUE;
+      temp->auto_pop = auto_pop;
+      return temp->t;
+    }
+
+  /* Create a new temp. */
+
+  yes = suspend_momentary ();
+
+  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_expr_%d", NULL,
+						  mynumber++),
+		  type);
+  {	/* ~~~~ kludge alert here!!! else temp gets reused outside
+	   a compound-statement sequence.... */
+    extern tree sequence_rtl_expr;
+    tree back_end_bug = sequence_rtl_expr;
+
+    sequence_rtl_expr = NULL_TREE;
+
+    t = start_decl (t, FALSE);
+    finish_decl (t, NULL_TREE, FALSE);
+
+    sequence_rtl_expr = back_end_bug;
+  }
+
+  resume_momentary (yes);
+
+  temp = malloc_new_kp (ffe_pool_program_unit (), "ffecomTemp_",
+			sizeof (*temp));
+
+  temp->next = ffecom_latest_temp_;
+  temp->type = type;
+  temp->t = t;
+  temp->size = size;
+  temp->elements = elements;
+  temp->in_use = TRUE;
+  temp->auto_pop = auto_pop;
+
+  ffecom_latest_temp_ = temp;
+
+  return t;
+}
+
+#endif
+/* 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).  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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;
+}
+
+#endif
+/* Do save_expr only if tree is not error_mark_node.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree ffecom_save_tree (tree t)
+{
+  return save_expr (t);
+}
+#endif
+
+/* Public entry point for front end to access start_decl.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_start_decl (tree decl, bool is_initialized)
+{
+  DECL_INITIAL (decl) = is_initialized ? error_mark_node : NULL_TREE;
+  return start_decl (decl, FALSE);
+}
+
+#endif
+/* 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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+void
+ffecom_sym_commit (ffesymbol s UNUSED)
+{
+  assert (!ffesymbol_retractable ());
+}
+
+#endif
+/* ffecom_sym_end_transition -- Perform end transition on all symbols
+
+   ffecom_sym_end_transition();
+
+   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 FFECOM_targetCURRENT == FFECOM_targetGCC
+  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_);
+    }
+#endif
+
+  /* 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 FFECOM_targetCURRENT == FFECOM_targetGCC
+  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_);
+    }
+#endif
+
+  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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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
+}
+
+#endif
+/* Create temporary gcc label.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_temp_label ()
+{
+  tree glabel;
+  static int mynumber = 0;
+
+  glabel = build_decl (LABEL_DECL,
+		       ffecom_get_invented_identifier ("__g77_label_%d",
+						       NULL,
+						       mynumber++),
+		       void_type_node);
+  DECL_CONTEXT (glabel) = current_function_decl;
+  DECL_MODE (glabel) = VOIDmode;
+
+  return glabel;
+}
+
+#endif
+/* Return an expression that is usable as an arg in a conditional context
+   (IF, DO WHILE, .NOT., and so on).
+
+   Use the one provided for the back end as of >2.6.0.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_truth_value (tree expr)
+{
+  return truthvalue_conversion (expr);
+}
+
+#endif
+/* Return the inversion of a truth value (the inversion of what
+   ffecom_truth_value builds).
+
+   Apparently invert_truthvalue, which is properly in the back end, is
+   enough for now, so just use it.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_truth_value_invert (tree expr)
+{
+  return invert_truthvalue (ffecom_truth_value (expr));
+}
+
+#endif
+/* Return 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).  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_which_entrypoint_decl ()
+{
+  assert (ffecom_which_entrypoint_decl_ != NULL_TREE);
+
+  return ffecom_which_entrypoint_decl_;
+}
+
+#endif
+
+/* The following sections consists of private and public functions
+   that have the same names and perform roughly the same functions
+   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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+
+static void
+bison_rule_compstmt_ ()
+{
+  emit_line_note (input_filename, lineno);
+  expand_end_bindings (getdecls (), 1, 1);
+  poplevel (1, 1, 0);
+  pop_momentary ();
+}
+
+static void
+bison_rule_pushlevel_ ()
+{
+  emit_line_note (input_filename, lineno);
+  pushlevel (0);
+  clear_last_expr ();
+  push_momentary ();
+  expand_start_bindings (0);
+}
+
+/* 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.  */
+
+static tree
+builtin_function (char *name, tree type,
+		  enum built_in_function function_code, char *library_name)
+{
+  tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type);
+  DECL_EXTERNAL (decl) = 1;
+  TREE_PUBLIC (decl) = 1;
+  if (library_name)
+    DECL_ASSEMBLER_NAME (decl) = get_identifier (library_name);
+  make_decl_rtl (decl, NULL_PTR, 1);
+  pushdecl (decl);
+  if (function_code != NOT_BUILT_IN)
+    {
+      DECL_BUILT_IN (decl) = 1;
+      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));
+
+	  /* Make sure we put the new type in the same obstack as the old ones.
+	     If the old types are not both in the same obstack, use the
+	     permanent one.  */
+	  if (TYPE_OBSTACK (oldtype) == TYPE_OBSTACK (newtype))
+	    push_obstacks (TYPE_OBSTACK (oldtype), TYPE_OBSTACK (oldtype));
+	  else
+	    {
+	      push_obstacks_nochange ();
+	      end_temporary_allocation ();
+	    }
+
+	  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;
+	    }
+
+	  pop_obstacks ();
+	}
+      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)
+    {
+      /* Make sure we put the new type in the same obstack as the old ones.
+	 If the old types are not both in the same obstack, use the permanent
+	 one.  */
+      if (TYPE_OBSTACK (oldtype) == TYPE_OBSTACK (newtype))
+	push_obstacks (TYPE_OBSTACK (oldtype), TYPE_OBSTACK (oldtype));
+      else
+	{
+	  push_obstacks_nochange ();
+	  end_temporary_allocation ();
+	}
+
+      /* 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);
+	  if (TREE_CODE (olddecl) != FUNCTION_DECL)
+	    if (DECL_ALIGN (olddecl) > DECL_ALIGN (newdecl))
+	      DECL_ALIGN (newdecl) = DECL_ALIGN (olddecl);
+	}
+
+      /* Keep the old rtl since we can safely use it.  */
+      DECL_RTL (newdecl) = DECL_RTL (olddecl);
+
+      /* Merge the type qualifiers.  */
+      if (DECL_BUILT_IN_NONANSI (olddecl) && TREE_THIS_VOLATILE (olddecl)
+	  && !TREE_THIS_VOLATILE (newdecl))
+	TREE_THIS_VOLATILE (olddecl) = 0;
+      if (TREE_READONLY (newdecl))
+	TREE_READONLY (olddecl) = 1;
+      if (TREE_THIS_VOLATILE (newdecl))
+	{
+	  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_LINE (newdecl) = DECL_SOURCE_LINE (olddecl);
+	  DECL_SOURCE_FILE (newdecl) = DECL_SOURCE_FILE (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);
+
+#if BUILT_FOR_270
+      if (TREE_CODE (newdecl) == FUNCTION_DECL)
+	{
+	  DECL_STATIC_CONSTRUCTOR(newdecl) |= DECL_STATIC_CONSTRUCTOR(olddecl);
+	  DECL_STATIC_DESTRUCTOR (newdecl) |= DECL_STATIC_DESTRUCTOR (olddecl);
+	}
+#endif
+
+      pop_obstacks ();
+    }
+  /* 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 (olddecl) = 0;
+    }
+
+  /* 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 (newdecl) = 1;
+	  DECL_FUNCTION_CODE (newdecl) = DECL_FUNCTION_CODE (olddecl);
+	}
+      else
+	DECL_FRAME_SIZE (newdecl) = DECL_FRAME_SIZE (olddecl);
+
+      DECL_RESULT (newdecl) = DECL_RESULT (olddecl);
+      DECL_INITIAL (newdecl) = DECL_INITIAL (olddecl);
+      DECL_SAVED_INSNS (newdecl) = DECL_SAVED_INSNS (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);
+
+    bcopy ((char *) newdecl + sizeof (struct tree_common),
+	   (char *) olddecl + 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);
+  int temporary = allocation_temporary_p ();
+  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;
+	}
+    }
+
+  /* Pop back to the obstack that is current for this binding level. This is
+     because MAXINDEX, rtl, etc. to be made below must go in the permanent
+     obstack.  But don't discard the temporary data yet.  */
+  pop_obstacks ();
+
+  /* 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_PTR,
+				DECL_CONTEXT (decl) == 0,
+				0);
+    }
+
+  /* This test used to include TREE_PERMANENT, however, we have the same
+     problem with initializers at the function level.  Such initializers get
+     saved until the end of the function on the momentary_obstack.  */
+  if (!(TREE_CODE (decl) == FUNCTION_DECL && DECL_INLINE (decl))
+      && temporary
+  /* DECL_INITIAL is not defined in PARM_DECLs, since it shares space with
+     DECL_ARG_TYPE.  */
+      && TREE_CODE (decl) != PARM_DECL)
+    {
+      /* We need to remember that this array HAD an initialization, but
+	 discard the actual temporary nodes, since we can't have a permanent
+	 node keep pointing to them.  */
+      /* We make an exception for inline functions, since it's normal for a
+	 local extern redeclaration of an inline function to have a copy of
+	 the top-level decl's DECL_INLINE.  */
+      if ((DECL_INITIAL (decl) != 0)
+	  && (DECL_INITIAL (decl) != error_mark_node))
+	{
+	  /* If this is a const variable, then preserve the
+	     initializer instead of discarding it so that we can optimize
+	     references to it.  */
+	  /* This test used to include TREE_STATIC, but this won't be set
+	     for function level initializers.  */
+	  if (TREE_READONLY (decl))
+	    {
+	      preserve_initializer ();
+	      /* Hack?  Set the permanent bit for something that is
+		 permanent, but not on the permenent obstack, so as to
+		 convince output_constant_def to make its rtl on the
+		 permanent obstack.  */
+	      TREE_PERMANENT (DECL_INITIAL (decl)) = 1;
+
+	      /* The initializer and DECL must have the same (or equivalent
+		 types), but if the initializer is a STRING_CST, its type
+		 might not be on the right obstack, so copy the type
+		 of DECL.  */
+	      TREE_TYPE (DECL_INITIAL (decl)) = type;
+	    }
+	  else
+	    DECL_INITIAL (decl) = error_mark_node;
+	}
+    }
+
+  /* If requested, warn about definitions of large data objects.  */
+
+  if (warn_larger_than
+      && (TREE_CODE (decl) == VAR_DECL || TREE_CODE (decl) == PARM_DECL)
+      && !DECL_EXTERNAL (decl))
+    {
+      register tree decl_size = DECL_SIZE (decl);
+
+      if (decl_size && TREE_CODE (decl_size) == INTEGER_CST)
+	{
+	   unsigned units = TREE_INT_CST_LOW (decl_size) / BITS_PER_UNIT;
+
+	  if (units > larger_than_size)
+	    warning_with_decl (decl, "size of `%s' is %u bytes", units);
+	}
+    }
+
+  /* If we have gone back from temporary to permanent allocation, actually
+     free the temporary space that we no longer need.  */
+  if (temporary && !allocation_temporary_p ())
+    permanent_allocation (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 (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);
+  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 (input_filename, lineno, 0);
+
+  /* So we can tell if jump_optimize sets it to 1.  */
+  can_reach_end = 0;
+
+  /* Run the optimizers and output the assembler code for this function.  */
+  rest_of_compilation (fndecl);
+
+  /* Free all the tree nodes making up this function.  */
+  /* Switch back to allocating nodes permanently until we start another
+     function.  */
+  if (!nested)
+    permanent_allocation (1);
+
+  if (DECL_SAVED_INSNS (fndecl) == 0 && !nested)
+    {
+      /* 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 char *
+lang_printable_name (tree decl, char **kind)
+{
+  *kind = "program unit";
+  return IDENTIFIER_POINTER (DECL_NAME (decl));
+}
+
+/* g77's function to print out name of current function that caused
+   an error.  */
+
+#if BUILT_FOR_270
+void
+lang_print_error_function (file)
+     char *file;
+{
+  static ffesymbol last_s = NULL;
+  ffesymbol s;
+  char *kind;
+
+  if (ffecom_primary_entry_ == NULL)
+    {
+      s = NULL;
+      kind = NULL;
+    }
+  else if (ffecom_nested_entry_ == NULL)
+    {
+      s = ffecom_primary_entry_;
+      switch (ffesymbol_kind (s))
+	{
+	case FFEINFO_kindFUNCTION:
+	  kind = "function";
+	  break;
+
+	case FFEINFO_kindSUBROUTINE:
+	  kind = "subroutine";
+	  break;
+
+	case FFEINFO_kindPROGRAM:
+	  kind = "program";
+	  break;
+
+	case FFEINFO_kindBLOCKDATA:
+	  kind = "block-data";
+	  break;
+
+	default:
+	  kind = ffeinfo_kind_message (ffesymbol_kind (s));
+	  break;
+	}
+    }
+  else
+    {
+      s = ffecom_nested_entry_;
+      kind = "statement function";
+    }
+
+  if (last_s != s)
+    {
+      if (file)
+	fprintf (stderr, "%s: ", file);
+
+      if (s == NULL)
+	fprintf (stderr, "Outside of any program unit:\n");
+      else
+	{
+	  char *name = ffesymbol_text (s);
+
+	  fprintf (stderr, "In %s `%s':\n", kind, name);
+	}
+
+      last_s = s;
+    }
+}
+#endif
+
+/* 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 binding_level'.  */
+
+static struct binding_level *
+make_binding_level ()
+{
+  /* NOSTRICT */
+  return (struct binding_level *) xmalloc (sizeof (struct 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 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 ()
+{
+  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 (DECL_SAVED_INSNS (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 ()
+{
+  struct f_function *p
+  = (struct f_function *) 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;
+
+  push_obstacks_nochange ();
+
+  /* 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 (x)
+     tree x;
+{
+  register tree t;
+  register struct 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 (decls)
+     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;
+
+  /* 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, input_filename, lineno);
+
+  /* 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);
+
+  /* The corresponding pop_obstacks is in finish_decl.  */
+  push_obstacks_nochange ();
+
+  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 (tem) == 0)
+    {
+      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);
+    }
+
+  if (DECL_INITIAL (tem) != NULL_TREE)
+    {
+      /* When parsing and digesting the initializer, use temporary storage.
+	 Do this even if we will ignore the value.  */
+      if (at_top_level)
+	temporary_allocation ();
+    }
+
+  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
+   yyparse 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);
+    }
+
+  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);
+
+  make_function_rtl (current_function_decl);
+
+  restype = TREE_TYPE (TREE_TYPE (current_function_decl));
+  DECL_RESULT (current_function_decl)
+    = build_decl (RESULT_DECL, NULL_TREE, restype);
+
+  if (!nested)
+    /* Allocate further tree nodes temporarily during compilation of this
+       function only.  */
+    temporary_allocation ();
+
+  if (!nested)
+    TREE_ADDRESSABLE (current_function_decl) = 1;
+
+  immediate_size_expand = old_immediate_size_expand;
+}
+
+/* Here are the public functions the GNU back end needs.  */
+
+/* This is used by the `assert' macro.  It is provided in libgcc.a,
+   which `cc' doesn't know how to link.  Note that the C++ front-end
+   no longer actually uses the `assert' macro (instead, it calls
+   my_friendly_assert).  But all of the back-end files still need this.  */
+void
+__eprintf (string, expression, line, filename)
+#ifdef __STDC__
+     const char *string;
+     const char *expression;
+     unsigned line;
+     const char *filename;
+#else
+     char *string;
+     char *expression;
+     unsigned line;
+     char *filename;
+#endif
+{
+  fprintf (stderr, string, expression, line, filename);
+  fflush (stderr);
+  abort ();
+}
+
+tree
+convert (type, expr)
+     tree type, 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;
+}
+
+/* integrate_decl_tree calls this function, but since we don't use the
+   DECL_LANG_SPECIFIC field, this is a no-op.  */
+
+void
+copy_lang_decl (node)
+     tree node UNUSED;
+{
+}
+
+/* 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 ()
+{
+  return current_binding_level->names;
+}
+
+/* Nonzero if we are currently in the global binding level.  */
+
+int
+global_bindings_p ()
+{
+  return current_binding_level == global_binding_level;
+}
+
+/* Insert BLOCK at the end of the list of subblocks of the
+   current binding level.  This is used when a BIND_EXPR is expanded,
+   to handle the BLOCK node inside the BIND_EXPR.  */
+
+void
+incomplete_type_error (value, type)
+     tree value UNUSED;
+     tree type;
+{
+  if (TREE_CODE (type) == ERROR_MARK)
+    return;
+
+  assert ("incomplete type?!?" == NULL);
+}
+
+void
+init_decl_processing ()
+{
+  malloc_init ();
+  ffe_init_0 ();
+}
+
+void
+init_lex ()
+{
+#if BUILT_FOR_270
+  extern void (*print_error_function) (char *);
+#endif
+
+  /* Make identifier nodes long enough for the language-specific slots.  */
+  set_identifier_size (sizeof (struct lang_identifier));
+  decl_printable_name = lang_printable_name;
+#if BUILT_FOR_270
+  print_error_function = lang_print_error_function;
+#endif
+}
+
+void
+insert_block (block)
+     tree block;
+{
+  TREE_USED (block) = 1;
+  current_binding_level->blocks
+    = chainon (current_binding_level->blocks, block);
+}
+
+int
+lang_decode_option (p)
+     char *p;
+{
+  return ffe_decode_option (p);
+}
+
+void
+lang_finish ()
+{
+  ffe_terminate_0 ();
+
+  if (ffe_is_ffedebug ())
+    malloc_pool_display (malloc_pool_image ());
+}
+
+char *
+lang_identify ()
+{
+  return "f77";
+}
+
+void
+lang_init ()
+{
+  extern FILE *finput;		/* Don't pollute com.h with this. */
+
+  /* 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);
+}
+
+int
+mark_addressable (exp)
+     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 1;
+
+      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 0;
+	      }
+	    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 0;
+	      }
+	    assert ("address of register var requested" == NULL);
+	  }
+	put_var_into_stack (x);
+
+	/* 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 1;
+      }
+}
+
+/* If DECL has a cleanup, build and return that cleanup here.
+   This is a callback called by expand_expr.  */
+
+tree
+maybe_build_cleanup (decl)
+     tree decl UNUSED;
+{
+  /* There are no cleanups in Fortran.  */
+  return NULL_TREE;
+}
+
+/* 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 (keep, reverse, functionbody)
+     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.  */
+	if (DECL_ABSTRACT_ORIGIN (decl) != 0)
+	  TREE_ADDRESSABLE (DECL_ABSTRACT_ORIGIN (decl)) = 1;
+	else
+	  {
+	    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;
+      remember_end_note (block);
+    }
+
+  /* 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 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)
+    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);
+
+  /* Set the TYPE_CONTEXTs for all of the tagged types belonging to this
+     binding contour so that they point to the appropriate construct, i.e.
+     either to the current FUNCTION_DECL node, or else to the BLOCK node we
+     just constructed.
+
+     Note that for tagged types whose scope is just the formal parameter list
+     for some function type specification, we can't properly set their
+     TYPE_CONTEXTs here, because we don't have a pointer to the appropriate
+     FUNCTION_TYPE node readily available to us.  For those cases, the
+     TYPE_CONTEXTs of the relevant tagged type nodes get set in
+     `grokdeclarator' as soon as we have created the FUNCTION_TYPE node which
+     will represent the "scope" for these "parameter list local" tagged
+     types. */
+
+  if (block)
+    TREE_USED (block) = 1;
+  return block;
+}
+
+void
+print_lang_decl (file, node, indent)
+     FILE *file UNUSED;
+     tree node UNUSED;
+     int indent UNUSED;
+{
+}
+
+void
+print_lang_identifier (file, node, indent)
+     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);
+}
+
+void
+print_lang_statistics ()
+{
+}
+
+void
+print_lang_type (file, node, indent)
+     FILE *file UNUSED;
+     tree node UNUSED;
+     int indent UNUSED;
+{
+}
+
+/* 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 (x)
+     tree x;
+{
+  register tree t;
+  register tree name = DECL_NAME (x);
+  register struct 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))
+	{
+#if BUILT_FOR_270
+	  DECL_ARTIFICIAL (x) = 1;
+#endif
+	  DECL_IN_SYSTEM_HEADER (x) = 1;
+	  DECL_IGNORED_P (x) = 1;
+	  TREE_USED (x) = 1;
+	  if (TREE_CODE (x) == TYPE_DECL)
+	    TYPE_DECL_SUPPRESS_DEBUG (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 if 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;
+}
+
+/* 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 (tag_transparent)
+     int tag_transparent;
+{
+  register struct binding_level *newlevel = NULL_BINDING_LEVEL;
+
+  assert (!tag_transparent);
+
+  /* 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 (block)
+     register tree block;
+{
+  current_binding_level->this_block = block;
+}
+
+/* ~~tree.h SHOULD declare this, because toplev.c references it.  */
+
+/* Can't 'yydebug' a front end not generated by yacc/bison!  */
+
+void
+set_yydebug (value)
+     int value;
+{
+  if (value)
+    fprintf (stderr, "warning: no yacc/bison-generated output to debug!\n");
+}
+
+tree
+signed_or_unsigned_type (unsignedp, 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 = type_for_size (TYPE_PRECISION (type), unsignedp);
+  if (type2 == NULL_TREE)
+    return type;
+
+  return type2;
+}
+
+tree
+signed_type (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 = 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'.  */
+
+tree
+truthvalue_conversion (expr)
+     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 (1 == TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (expr, 1)))
+	  && TREE_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,
+		       truthvalue_conversion (TREE_OPERAND (expr, 0)),
+		       truthvalue_conversion (TREE_OPERAND (expr, 1)));
+
+    case NEGATE_EXPR:
+    case ABS_EXPR:
+    case FLOAT_EXPR:
+    case FFS_EXPR:
+      /* These don't change whether an object is non-zero or zero.  */
+      return truthvalue_conversion (TREE_OPERAND (expr, 0));
+
+    case LROTATE_EXPR:
+    case RROTATE_EXPR:
+      /* These don't change whether an object is zero or non-zero, 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),
+		      truthvalue_conversion (TREE_OPERAND (expr, 0)));
+      else
+	return truthvalue_conversion (TREE_OPERAND (expr, 0));
+
+    case COND_EXPR:
+      /* Distribute the conversion into the arms of a COND_EXPR.  */
+      return fold (build (COND_EXPR, integer_type_node, TREE_OPERAND (expr, 0),
+			  truthvalue_conversion (TREE_OPERAND (expr, 1)),
+			  truthvalue_conversion (TREE_OPERAND (expr, 2))));
+
+    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 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,
+	     truthvalue_conversion (ffecom_1 (REALPART_EXPR,
+					      TREE_TYPE (TREE_TYPE (expr)),
+					      expr)),
+	     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));
+}
+
+tree
+type_for_mode (mode, unsignedp)
+     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 (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 (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;
+}
+
+tree
+type_for_size (bits, unsignedp)
+     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;
+}
+
+tree
+unsigned_type (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 = 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;
+}
+
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+#if FFECOM_GCC_INCLUDE
+
+/* 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 char *
+skip_redundant_dir_prefix (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;
+    char *fname;
+    /* Mapping of file names for this directory.  */
+    struct file_name_map *name_map;
+    /* Non-zero 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 {
+  char *fname;
+  /* Filename specified with #line command.  */
+  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.  */
+static int input_file_stack_tick = 0;  /* Incremented when status changes.  */
+
+/* Current nesting level of input sources.
+   `instack[indepth]' is the level currently being read.  */
+static int indepth = -1;
+
+typedef struct file_buf FILE_BUF;
+
+typedef unsigned char U_CHAR;
+
+/* table to tell if char can be part of a C identifier. */
+U_CHAR is_idchar[256];
+/* table to tell if char can be first char of a c identifier. */
+U_CHAR is_idstart[256];
+/* table to tell if c is horizontal space.  */
+U_CHAR is_hor_space[256];
+/* table to tell if c is horizontal or vertical space.  */
+static U_CHAR is_space[256];
+
+#define SKIP_WHITE_SPACE(p) do { while (is_hor_space[*p]) p++; } while (0)
+#define SKIP_ALL_WHITE_SPACE(p) do { while (is_space[*p]) p++; } while (0)
+
+/* 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 *skip_redundant_dir_prefix (char *);
+static char *read_filename_string (int ch, FILE *f);
+static struct file_name_map *read_name_map (char *dirname);
+static char *savestring (char *input);
+
+/* 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 (first, last)
+     struct file_name_list *first, *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 (filename, searchptr)
+     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 = rindex (filename, '/');
+#ifdef DIR_SEPARATOR
+  if (! p) p = rindex (filename, DIR_SEPARATOR);
+  else {
+    char *tmp = rindex (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 = (char *) xmalloc (p - filename + 1);
+      bcopy (filename, dir, 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;
+  char *str1;
+  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 = "";
+
+	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 (ch, f)
+     int ch;
+     FILE *f;
+{
+  char *alloc, *set;
+  int len;
+
+  len = 20;
+  set = alloc = xmalloc (len + 1);
+  if (! is_space[ch])
+    {
+      *set++ = ch;
+      while ((ch = getc (f)) != EOF && ! is_space[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 (dirname)
+     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 = ((struct file_name_map_list *)
+		  xmalloc (sizeof (struct file_name_map_list)));
+  map_list_ptr->map_list_name = savestring (dirname);
+  map_list_ptr->map_list_map = NULL;
+
+  dirlen = strlen (dirname);
+  separator_needed = dirlen != 0 && dirname[dirlen - 1] != '/';
+  name = (char *) xmalloc (dirlen + strlen (FILE_NAME_MAP_FILE) + 2);
+  strcpy (name, dirname);
+  name[dirlen] = '/';
+  strcpy (name + dirlen + separator_needed, FILE_NAME_MAP_FILE);
+  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 (is_space[ch])
+	    continue;
+	  from = read_filename_string (ch, f);
+	  while ((ch = getc (f)) != EOF && is_hor_space[ch])
+	    ;
+	  to = read_filename_string (ch, f);
+
+	  ptr = ((struct file_name_map *)
+		 xmalloc (sizeof (struct file_name_map)));
+	  ptr->map_from = from;
+
+	  /* Make the real filename absolute.  */
+	  if (*to == '/')
+	    ptr->map_to = to;
+	  else
+	    {
+	      ptr->map_to = xmalloc (dirlen + strlen (to) + 2);
+	      strcpy (ptr->map_to, dirname);
+	      ptr->map_to[dirlen] = '/';
+	      strcpy (ptr->map_to + dirlen + separator_needed, to);
+	      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 char *
+savestring (input)
+     char *input;
+{
+  unsigned size = strlen (input);
+  char *output = xmalloc (size + 1);
+  strcpy (output, input);
+  return output;
+}
+
+static void
+ffecom_file_ (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];
+  bzero ((char *) fp, sizeof (FILE_BUF));
+  if (name == NULL)
+    name = "";
+  fp->nominal_fname = fp->fname = name;
+}
+
+/* Initialize syntactic classifications of characters.  */
+
+static void
+ffecom_initialize_char_syntax_ ()
+{
+  register int i;
+
+  /*
+   * Set up is_idchar and is_idstart tables.  These should be
+   * faster than saying (is_alpha (c) || c == '_'), etc.
+   * Set up these things before calling any routines tthat
+   * refer to them.
+   */
+  for (i = 'a'; i <= 'z'; i++) {
+    is_idchar[i - 'a' + 'A'] = 1;
+    is_idchar[i] = 1;
+    is_idstart[i - 'a' + 'A'] = 1;
+    is_idstart[i] = 1;
+  }
+  for (i = '0'; i <= '9'; i++)
+    is_idchar[i] = 1;
+  is_idchar['_'] = 1;
+  is_idstart['_'] = 1;
+
+  /* horizontal space table */
+  is_hor_space[' '] = 1;
+  is_hor_space['\t'] = 1;
+  is_hor_space['\v'] = 1;
+  is_hor_space['\f'] = 1;
+  is_hor_space['\r'] = 1;
+
+  is_space[' '] = 1;
+  is_space['\t'] = 1;
+  is_space['\v'] = 1;
+  is_space['\f'] = 1;
+  is_space['\n'] = 1;
+  is_space['\r'] = 1;
+}
+
+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);
+}
+
+static int
+ffecom_decode_include_option_ (char *spec)
+{
+  struct file_name_list *dirtmp;
+
+  if (! ignore_srcdir && !strcmp (spec, "-"))
+    ignore_srcdir = 1;
+  else
+    {
+      dirtmp = (struct file_name_list *)
+	xmalloc (sizeof (struct file_name_list));
+      dirtmp->next = 0;		/* New one goes on the end */
+      if (spec[0] != 0)
+	dirtmp->fname = spec;
+      else
+	fatal ("Directory name must immediately follow -I option with no intervening spaces, as in `-Idir', not `-I dir'");
+      dirtmp->got_name_map = 0;
+      append_include_chain (dirtmp, dirtmp);
+    }
+  return 1;
+}
+
+/* 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;
+	  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 = rindex (nam, '/');
+#ifdef DIR_SEPARATOR
+	    if (ep == NULL) ep = rindex (nam, DIR_SEPARATOR);
+	    else {
+	      char *tmp = rindex (nam, DIR_SEPARATOR);
+	      if (tmp != NULL && tmp > ep) ep = tmp;
+	    }
+#endif
+#else				/* VMS */
+	      ep = rindex (nam, ']');
+	      if (ep == NULL) ep = rindex (nam, '>');
+	      if (ep == NULL) ep = rindex (nam, ':');
+	      if (ep != NULL) ep++;
+#endif				/* VMS */
+	      if (ep != NULL)
+		{
+		  n = ep - nam;
+		  dsp[0].fname = (char *) xmalloc (n + 1);
+		  strncpy (dsp[0].fname, nam, n);
+		  dsp[0].fname[n] = '\0';
+		  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_PTR);
+    }
+  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 (index (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);
+	      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 (dsp[0].fname);
+
+  if (f == NULL)
+    return NULL;
+
+  if (indepth >= (INPUT_STACK_MAX - 1))
+    {
+      print_containing_files (FFEBAD_severityFATAL);
+      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];
+  bzero ((char *) fp, sizeof (FILE_BUF));
+  fp->nominal_fname = fp->fname = fname;
+  fp->dir = searchptr;
+
+  indepth++;
+  input_file_stack_tick++;
+
+  return f;
+}
+#endif	/* FFECOM_GCC_INCLUDE */
diff --git a/gcc/f/com.h b/gcc/f/com.h
new file mode 100644
index 00000000000..477e0860f40
--- /dev/null
+++ b/gcc/f/com.h
@@ -0,0 +1,419 @@
+/* com.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995-1997 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_com
+#define _H_f_com
+
+/* Simple definitions and enumerations. */
+
+#define FFECOM_dimensionsMAX 7	/* Max # dimensions (quick hack). */
+
+#define FFECOM_targetFFE 1
+#define FFECOM_targetGCC 2
+
+#ifndef FFE_STANDALONE
+#define FFECOM_targetCURRENT FFECOM_targetGCC	/* Backend! */
+#define FFECOM_ONEPASS 0
+#else
+#define FFECOM_targetCURRENT FFECOM_targetFFE
+#define FFECOM_ONEPASS 0
+#endif
+
+#if FFECOM_ONEPASS
+#define FFECOM_TWOPASS 0
+#else
+#define FFECOM_TWOPASS 1
+#endif
+
+#define FFECOM_SIZE_UNIT "byte"	/* Singular form. */
+#define FFECOM_SIZE_UNITS "bytes"	/* Plural form. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#define FFECOM_constantNULL NULL_TREE
+#define FFECOM_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.  */
+
+#include "config.j"
+
+/* Do we need int (for 32-bit or 64-bit systems) or long (16-bit or
+   normally 32-bit) for f2c-type integers? */
+
+#ifndef BITS_PER_WORD
+#define BITS_PER_WORD 32
+#endif
+
+#ifndef CHAR_TYPE_SIZE
+#define CHAR_TYPE_SIZE BITS_PER_UNIT
+#endif
+
+#ifndef SHORT_TYPE_SIZE
+#define SHORT_TYPE_SIZE (BITS_PER_UNIT * MIN ((UNITS_PER_WORD + 1) / 2, 2))
+#endif
+
+#ifndef INT_TYPE_SIZE
+#define INT_TYPE_SIZE BITS_PER_WORD
+#endif
+
+#ifndef LONG_TYPE_SIZE
+#define LONG_TYPE_SIZE BITS_PER_WORD
+#endif
+
+#ifndef LONG_LONG_TYPE_SIZE
+#define LONG_LONG_TYPE_SIZE (BITS_PER_WORD * 2)
+#endif
+
+#ifndef WCHAR_UNSIGNED
+#define WCHAR_UNSIGNED 0
+#endif
+
+#ifndef FLOAT_TYPE_SIZE
+#define FLOAT_TYPE_SIZE BITS_PER_WORD
+#endif
+
+#ifndef DOUBLE_TYPE_SIZE
+#define DOUBLE_TYPE_SIZE (BITS_PER_WORD * 2)
+#endif
+
+#ifndef LONG_DOUBLE_TYPE_SIZE
+#define LONG_DOUBLE_TYPE_SIZE (BITS_PER_WORD * 2)
+#endif
+
+#if LONG_TYPE_SIZE == FLOAT_TYPE_SIZE
+#  define FFECOM_f2cINTEGER FFECOM_f2ccodeLONG
+#  define FFECOM_f2cLOGICAL FFECOM_f2ccodeLONG
+#elif INT_TYPE_SIZE == FLOAT_TYPE_SIZE
+#  define FFECOM_f2cINTEGER FFECOM_f2ccodeINT
+#  define FFECOM_f2cLOGICAL FFECOM_f2ccodeINT
+#else
+#  error Cannot find a suitable type for FFECOM_f2cINTEGER
+#endif
+
+#if LONG_TYPE_SIZE == (FLOAT_TYPE_SIZE * 2)
+#  define FFECOM_f2cLONGINT FFECOM_f2ccodeLONG
+#elif LONG_LONG_TYPE_SIZE == (FLOAT_TYPE_SIZE * 2)
+#  define FFECOM_f2cLONGINT FFECOM_f2ccodeLONGLONG
+#else
+#  error Cannot find a suitable type for FFECOM_f2cLONGINT
+#endif
+
+#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) CODE,
+#include "com-rt.def"
+#undef DEFGFRT
+    FFECOM_gfrt
+  } ffecomGfrt;
+
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+/* Typedefs. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#ifndef TREE_CODE
+#include "tree.j"
+#endif
+
+#ifndef BUILT_FOR_270
+#ifdef DECL_STATIC_CONSTRUCTOR	/* In gcc/tree.h. */
+#define BUILT_FOR_270 1
+#else
+#define BUILT_FOR_270 0
+#endif
+#endif	/* !defined (BUILT_FOR_270) */
+
+#ifndef BUILT_FOR_280
+#ifdef DECL_ONE_ONLY	/* In gcc/tree.h. */
+#define BUILT_FOR_280 1
+#else
+#define BUILT_FOR_280 0
+#endif
+#endif	/* !defined (BUILT_FOR_280) */
+
+typedef tree ffecomConstant;
+#define FFECOM_constantHOOK
+typedef tree ffecomLabel;
+#define FFECOM_globalHOOK
+typedef tree ffecomGlobal;
+#define FFECOM_labelHOOK
+typedef tree ffecomStorage;
+#define FFECOM_storageHOOK
+typedef struct _ffecom_symbol_ ffecomSymbol;
+#define FFECOM_symbolHOOK
+
+struct _ffecom_symbol_
+  {
+    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. */
+  };
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+/* Include files needed by this one. */
+
+#include "bld.h"
+#include "info.h"
+#include "lab.h"
+#include "storag.h"
+#include "symbol.h"
+
+/* Structure definitions. */
+
+
+/* Global objects accessed by users of this module. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+extern tree long_integer_type_node;
+extern tree complex_double_type_node;
+extern tree string_type_node;
+extern tree ffecom_integer_type_node;
+extern tree ffecom_integer_zero_node;
+extern tree ffecom_integer_one_node;
+extern 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 tree ffecom_f2c_integer_type_node;
+extern tree ffecom_f2c_address_type_node;
+extern tree ffecom_f2c_real_type_node;
+extern tree ffecom_f2c_doublereal_type_node;
+extern tree ffecom_f2c_complex_type_node;
+extern tree ffecom_f2c_doublecomplex_type_node;
+extern tree ffecom_f2c_longint_type_node;
+extern tree ffecom_f2c_logical_type_node;
+extern tree ffecom_f2c_flag_type_node;
+extern tree ffecom_f2c_ftnlen_type_node;
+extern tree ffecom_f2c_ftnlen_zero_node;
+extern tree ffecom_f2c_ftnlen_one_node;
+extern tree ffecom_f2c_ftnlen_two_node;
+extern tree ffecom_f2c_ptr_to_ftnlen_type_node;
+extern tree ffecom_f2c_ftnint_type_node;
+extern tree ffecom_f2c_ptr_to_ftnint_type_node;
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+/* Declare functions with prototypes. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree ffecom_1 (enum tree_code code, tree type, tree node);
+tree ffecom_1_fn (tree node);
+tree ffecom_2 (enum tree_code code, tree type, tree node1, tree node2);
+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_expr (ffebld expr, tree *length);
+tree ffecom_call_gfrt (ffecomGfrt ix, tree args);
+tree ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt,
+			   ffeinfoKindtype kt, tree tree_type);
+tree ffecom_decl_field (tree context, tree prevfield, char *name,
+			tree type);
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
+void ffecom_close_include (FILE *f);
+int ffecom_decode_include_option (char *spec);
+void ffecom_end_transition (void);
+void ffecom_exec_transition (void);
+void ffecom_expand_let_stmt (ffebld dest, ffebld source);
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree ffecom_expr (ffebld expr);
+tree ffecom_expr_assign (ffebld expr);
+tree ffecom_expr_assign_w (ffebld expr);
+tree ffecom_expr_rw (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 (char *pattern, char *text,
+				     int number);
+ffeinfoKindtype 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_modify (tree newtype, tree lhs, tree rhs);
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
+void ffecom_file (char *name);
+void ffecom_notify_init_storage (ffestorag st);
+void ffecom_notify_init_symbol (ffesymbol s);
+void ffecom_notify_primary_entry (ffesymbol fn);
+FILE *ffecom_open_include (char *name, ffewhereLine l, ffewhereColumn c);
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+void ffecom_pop_calltemps (void);
+void ffecom_pop_tempvar (tree var);
+tree ffecom_ptr_to_expr (ffebld expr);
+void ffecom_push_calltemps (void);
+tree ffecom_push_tempvar (tree type, ffetargetCharacterSize size,
+			  int elements, bool auto_pop);
+tree ffecom_return_expr (ffebld expr);
+tree ffecom_save_tree (tree t);
+tree ffecom_start_decl (tree decl, bool is_init);
+void ffecom_sym_commit (ffesymbol s);
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
+ffesymbol ffecom_sym_end_transition (ffesymbol s);
+ffesymbol ffecom_sym_exec_transition (ffesymbol s);
+ffesymbol ffecom_sym_learned (ffesymbol s);
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+void ffecom_sym_retract (ffesymbol s);
+tree ffecom_temp_label (void);
+tree ffecom_truth_value (tree expr);
+tree ffecom_truth_value_invert (tree expr);
+tree ffecom_which_entrypoint_decl (void);
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+/* ~~~Eliminate these when possible, since the back end should be
+   declaring them in some .h file.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+extern int flag_pedantic_errors;
+void emit_nop (void);
+void announce_function (tree decl);
+extern FILE *asm_out_file;
+void assemble_variable (tree decl, int top_level, int at_end,
+			int dont_output_data);
+void assemble_zeros (int size);
+int count_error (int warningp);
+void error (char *s, ...);
+void expand_decl (tree decl);
+void expand_computed_goto (tree exp);
+void expand_function_end (char *filename, int line, int end_bindings);
+void expand_function_start (tree subr, int parms_have_cleanups);
+void expand_main_function (void);
+void fatal (char *s, ...);
+void init_function_start (tree subr, char *filename, int line);
+void make_function_rtl (tree decl);
+void make_decl_rtl (tree decl, char *asmspec, int top_level);
+void make_var_volatile (tree var);
+int mark_addressable (tree expr);
+void output_inline_function (tree fndecl);
+void pedwarn (char *s, ...);
+void pop_function_context (void);
+void pop_momentary_nofree (void);
+void preserve_initializer (void);
+void print_node (FILE *file, char *prefix, tree node, int indent);
+void push_function_context (void);
+void push_obstacks (struct obstack *current, struct obstack *saveable);
+void put_var_into_stack (tree decl);
+void remember_end_note (tree block);
+void report_error_function (char *file);
+void rest_of_compilation (tree decl);
+void rest_of_decl_compilation (tree decl, char *asmspec, int top_level,
+			       int at_end);
+void resume_temporary_allocation (void);
+void set_identifier_size (int size);
+void temporary_allocation (void);
+tree truthvalue_conversion (tree expr);
+void warning_with_decl (tree decl, char *s, ...);
+void warning (char *s, ...);
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+/* Define macros. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+#define ffecom_expr(e) (e)
+#define ffecom_init_0()
+#define ffecom_init_2()
+#define ffecom_label_kind() FFEINFO_kindtypeINTEGERDEFAULT
+#define ffecom_pointer_kind() FFEINFO_kindtypeINTEGERDEFAULT
+#define ffecom_ptr_to_expr(e) (e)
+#define ffecom_sym_commit(s)
+#define ffecom_sym_retract(s)
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetFFE */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#define ffecom_f2c_typecode(bt,kt) ffecom_f2c_typecode_[(bt)][(kt)]
+#define ffecom_label_kind() ffecom_label_kind_
+#define ffecom_pointer_kind() ffecom_pointer_kind_
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+#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
diff --git a/gcc/f/config-lang.in b/gcc/f/config-lang.in
new file mode 100644
index 00000000000..74626241d8c
--- /dev/null
+++ b/gcc/f/config-lang.in
@@ -0,0 +1,100 @@
+# Top level configure fragment for GNU FORTRAN.
+#   Copyright (C) 1995-1997 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)
+# diff_excludes	- files to ignore when building diffs between two versions.
+
+if grep DECL_STATIC_CONSTRUCTOR $srcdir/tree.h >/dev/null; then
+   if grep flag_move_all_movables $srcdir/toplev.c >/dev/null; then true
+   else
+      echo "You haven't applied the patches to the GCC 2.7.x distribution in"
+      echo "$srcdir as described in g77/README.g77 and gcc/f/gbe/README."
+      echo ""
+      exit 1
+   fi
+else
+   if grep put_pending_sizes $srcdir/stor-layout.c >/dev/null; then true
+   else
+      echo "You haven't applied the patches to the GCC 2.6.x distribution in"
+      echo "$srcdir as described in g77/README.g77 and gcc/f/gbe/README."
+      echo ""
+      exit 1
+   fi
+fi
+
+language="f77"
+
+compilers="f771\$(exeext)"
+
+case "$arguments" in
+# *--enable-f2c* | *-enable-f2c*)
+#   echo "f77: enabling f2c."
+#  stagestuff="g77 g77-cross f771 libf2c.a f2c fc" ;;
+#  stagestuff="g77 g77-cross f771 libf2c.a f2c" ;;
+*)
+  stagestuff="g77\$(exeext) g77-cross\$(exeext) f771\$(exeext) libf2c.a" ;;
+esac
+
+diff_excludes="-x \"f/g77.info*\""
+
+# Create the runtime library directory tree if necessary.
+test -d f || mkdir f
+test -d f/runtime || mkdir f/runtime
+test -d f/runtime/libF77 || mkdir f/runtime/libF77
+test -d f/runtime/libI77 || mkdir f/runtime/libI77
+test -d f/runtime/libU77 || mkdir f/runtime/libU77
+
+# Need to make top-level stageN directory trees, else if needed
+# later by gcc/Makefile, it'll make only the first levels and
+# the language subdirectory levels, not the runtime stuff.
+for stageN in stage1 stage2 stage3 stage4
+do
+	test -d $stageN || mkdir $stageN
+	test -d $stageN/f || mkdir $stageN/f
+	test -d $stageN/f/runtime || mkdir $stageN/f/runtime
+	test -d $stageN/f/runtime/libF77 || mkdir $stageN/f/runtime/libF77
+	test -d $stageN/f/runtime/libI77 || mkdir $stageN/f/runtime/libI77
+	test -d $stageN/f/runtime/libU77 || mkdir $stageN/f/runtime/libU77
+done
+
+# Make links into top-level stageN from target trees.
+for stageN in stage1 stage2 stage3 stage4 include
+do
+	$remove -f f/$stageN f/runtime/$stageN f/runtime/libF77/$stageN \
+		f/runtime/libI77/$stageN f/runtime/libU77/$stageN
+	(cd f; $symbolic_link ../$stageN . 2>/dev/null)
+	(cd f/runtime; $symbolic_link ../$stageN . 2>/dev/null)
+	(cd f/runtime/libF77; $symbolic_link ../$stageN . 2>/dev/null)
+	(cd f/runtime/libI77; $symbolic_link ../$stageN . 2>/dev/null)
+	(cd f/runtime/libU77; $symbolic_link ../$stageN . 2>/dev/null)
+done
+
+case "$srcdir" in
+.) ;;
+*) echo
+   echo "Building f77 outside the source directory is likely to not work"
+   echo "unless you are using GNU make or a compatible VPATH mechanism."
+   echo ;;
+esac
diff --git a/gcc/f/config.j b/gcc/f/config.j
new file mode 100644
index 00000000000..b70c3c07b34
--- /dev/null
+++ b/gcc/f/config.j
@@ -0,0 +1,27 @@
+/* config.j -- Wrapper for GCC's config.h
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 MAKING_DEPENDENCIES
+#ifndef _J_f_config
+#define _J_f_config
+#include "config.h"
+#endif
+#endif
diff --git a/gcc/f/convert.j b/gcc/f/convert.j
new file mode 100644
index 00000000000..c2e1e4f85d9
--- /dev/null
+++ b/gcc/f/convert.j
@@ -0,0 +1,28 @@
+/* convert.j -- Wrapper for GCC's convert.h
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 MAKING_DEPENDENCIES
+#ifndef _J_f_convert
+#define _J_f_convert
+#include "tree.j"
+#include "convert.h"
+#endif
+#endif
diff --git a/gcc/f/data.c b/gcc/f/data.c
new file mode 100644
index 00000000000..15bf3b00cbb
--- /dev/null
+++ b/gcc/f/data.c
@@ -0,0 +1,1810 @@
+/* data.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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_ ()
+{
+  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);
+
+	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));
+
+	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
+	  {
+	    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.  */
+
+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 = (ffedataConvertCache_) 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)
+    {
+      ++rank;
+      assert (dims != NULL);
+
+      subscript = ffebld_head (subscripts);
+      dim = ffebld_head (dims);
+
+      assert (ffeinfo_basictype (ffebld_info (subscript)) == FFEINFO_basictypeINTEGER);
+      assert (ffeinfo_kindtype (ffebld_info (subscript)) == FFEINFO_kindtypeINTEGER1);
+      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);
+	  assert (ffeinfo_kindtype (ffebld_info (low)) == FFEINFO_kindtypeINTEGERDEFAULT);
+	  lowbound = ffedata_eval_integer1_ (low);
+	}
+
+      assert (ffeinfo_basictype (ffebld_info (high)) == FFEINFO_basictypeINTEGER);
+      assert (ffeinfo_kindtype (ffebld_info (high)) == FFEINFO_kindtypeINTEGERDEFAULT);
+      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.  */
+
+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_);
+	  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_);
+	  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_);
+	  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_ ()
+{
+  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_ ()
+{
+  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_);
+	      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_);
+	  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
new file mode 100644
index 00000000000..a17aa2f8b27
--- /dev/null
+++ b/gcc/f/data.h
@@ -0,0 +1,74 @@
+/* data.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_data
+#define _H_f_data
+
+/* 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
diff --git a/gcc/f/equiv.c b/gcc/f/equiv.c
new file mode 100644
index 00000000000..7dd2344cecb
--- /dev/null
+++ b/gcc/f/equiv.c
@@ -0,0 +1,1444 @@
+/* equiv.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995-1997 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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. */
+
+	      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))
+		{
+		  ffetargetOffset new_size;
+
+		  /* 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 (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);
+
+	    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));
+
+	    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);
+		assert (ffeinfo_kindtype (ffebld_info (low))
+			== FFEINFO_kindtypeINTEGERDEFAULT);
+		lowbound
+		  = ffebld_constant_integerdefault (ffebld_conter (low));
+	      }
+
+	    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_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
+	  {
+	    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_dump -- Dump info on equivalence object
+
+   ffeequiv eq;
+   ffeequiv_dump(eq);  */
+
+void
+ffeequiv_dump (ffeequiv eq)
+{
+  if (ffeequiv_common (eq) != NULL)
+    fprintf (dmpout, "(common %s) ", ffesymbol_text (ffeequiv_common (eq)));
+  ffebld_dump (ffeequiv_list (eq));
+}
+
+/* ffeequiv_exec_transition -- Do the hard work on all the equivalence objects
+
+   ffeequiv_exec_transition();	*/
+
+void
+ffeequiv_exec_transition ()
+{
+  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 ()
+{
+  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 ()
+{
+  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
new file mode 100644
index 00000000000..225cafded1b
--- /dev/null
+++ b/gcc/f/equiv.h
@@ -0,0 +1,101 @@
+/* equiv.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_equiv
+#define _H_f_equiv
+
+/* 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_dump (ffeequiv eq);
+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
diff --git a/gcc/f/expr.c b/gcc/f/expr.c
new file mode 100644
index 00000000000..057293b0eef
--- /dev/null
+++ b/gcc/f/expr.c
@@ -0,0 +1,19405 @@
+/* expr.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995-1997 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 <ctype.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 "target.h"
+#include "where.h"
+
+/* Externals defined here. */
+
+
+/* Simple definitions and enumerations. */
+
+typedef enum
+  {
+    FFEEXPR_dotdotNONE_,
+    FFEEXPR_dotdotTRUE_,
+    FFEEXPR_dotdotFALSE_,
+    FFEEXPR_dotdotNOT_,
+    FFEEXPR_dotdotAND_,
+    FFEEXPR_dotdotOR_,
+    FFEEXPR_dotdotXOR_,
+    FFEEXPR_dotdotEQV_,
+    FFEEXPR_dotdotNEQV_,
+    FFEEXPR_dotdotLT_,
+    FFEEXPR_dotdotLE_,
+    FFEEXPR_dotdotEQ_,
+    FFEEXPR_dotdotNE_,
+    FFEEXPR_dotdotGT_,
+    FFEEXPR_dotdotGE_,
+    FFEEXPR_dotdot
+  } ffeexprDotdot_;
+
+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 ffeexprDotdot_ 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 ffeexprDotdot_ ffeexpr_dotdot_ (ffelexToken t);
+static ffeexprExpr_ ffeexpr_expr_new_ (void);
+static void ffeexpr_fulfill_call_ (ffebld *expr, ffelexToken t);
+static bool ffeexpr_isdigits_ (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);
+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
+
+#if FFETARGET_okREAL4
+		case FFEINFO_kindtypeREAL4:
+		  error = ffetarget_convert_integer1_real4
+		    (ffebld_cu_ptr_integer1 (u),
+		     ffebld_constant_real4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("INTEGER1/REAL bad source kind type" == NULL);
+		  break;
+		}
+	      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
+
+#if FFETARGET_okCOMPLEX4
+		case FFEINFO_kindtypeREAL4:
+		  error = ffetarget_convert_integer1_complex4
+		    (ffebld_cu_ptr_integer1 (u),
+		     ffebld_constant_complex4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("INTEGER1/COMPLEX bad source kind type" == NULL);
+		  break;
+		}
+	      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;
+	    }
+
+	  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
+
+#if FFETARGET_okREAL4
+		case FFEINFO_kindtypeREAL4:
+		  error = ffetarget_convert_integer2_real4
+		    (ffebld_cu_ptr_integer2 (u),
+		     ffebld_constant_real4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("INTEGER2/REAL bad source kind type" == NULL);
+		  break;
+		}
+	      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
+
+#if FFETARGET_okCOMPLEX4
+		case FFEINFO_kindtypeREAL4:
+		  error = ffetarget_convert_integer2_complex4
+		    (ffebld_cu_ptr_integer2 (u),
+		     ffebld_constant_complex4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("INTEGER2/COMPLEX bad source kind type" == NULL);
+		  break;
+		}
+	      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;
+	    }
+
+	  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
+
+#if FFETARGET_okREAL4
+		case FFEINFO_kindtypeREAL4:
+		  error = ffetarget_convert_integer3_real4
+		    (ffebld_cu_ptr_integer3 (u),
+		     ffebld_constant_real4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("INTEGER3/REAL bad source kind type" == NULL);
+		  break;
+		}
+	      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
+
+#if FFETARGET_okCOMPLEX4
+		case FFEINFO_kindtypeREAL4:
+		  error = ffetarget_convert_integer3_complex4
+		    (ffebld_cu_ptr_integer3 (u),
+		     ffebld_constant_complex4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("INTEGER3/COMPLEX bad source kind type" == NULL);
+		  break;
+		}
+	      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;
+	    }
+
+	  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
+
+#if FFETARGET_okREAL4
+		case FFEINFO_kindtypeREAL4:
+		  error = ffetarget_convert_integer4_real4
+		    (ffebld_cu_ptr_integer4 (u),
+		     ffebld_constant_real4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("INTEGER4/REAL bad source kind type" == NULL);
+		  break;
+		}
+	      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
+
+#if FFETARGET_okCOMPLEX4
+		case FFEINFO_kindtypeREAL4:
+		  error = ffetarget_convert_integer4_complex4
+		    (ffebld_cu_ptr_integer4 (u),
+		     ffebld_constant_complex4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("INTEGER3/COMPLEX bad source kind type" == NULL);
+		  break;
+		}
+	      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;
+	    }
+
+	  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;
+	    }
+
+	  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;
+	    }
+
+	  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;
+	    }
+
+	  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;
+	    }
+
+	  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
+
+#if FFETARGET_okREAL4
+		case FFEINFO_kindtypeREAL4:
+		  error = ffetarget_convert_real1_real4
+		    (ffebld_cu_ptr_real1 (u),
+		     ffebld_constant_real4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("REAL1/REAL bad source kind type" == NULL);
+		  break;
+		}
+	      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
+
+#if FFETARGET_okCOMPLEX4
+		case FFEINFO_kindtypeREAL4:
+		  error = ffetarget_convert_real1_complex4
+		    (ffebld_cu_ptr_real1 (u),
+		     ffebld_constant_complex4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("REAL1/COMPLEX bad source kind type" == NULL);
+		  break;
+		}
+	      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;
+	    }
+
+	  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
+
+#if FFETARGET_okREAL4
+		case FFEINFO_kindtypeREAL4:
+		  error = ffetarget_convert_real2_real4
+		    (ffebld_cu_ptr_real2 (u),
+		     ffebld_constant_real4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("REAL2/REAL bad source kind type" == NULL);
+		  break;
+		}
+	      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
+
+#if FFETARGET_okCOMPLEX4
+		case FFEINFO_kindtypeREAL4:
+		  error = ffetarget_convert_real2_complex4
+		    (ffebld_cu_ptr_real2 (u),
+		     ffebld_constant_complex4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("REAL2/COMPLEX bad source kind type" == NULL);
+		  break;
+		}
+	      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;
+	    }
+
+	  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
+
+#if FFETARGET_okREAL4
+		case FFEINFO_kindtypeREAL4:
+		  error = ffetarget_convert_real3_real4
+		    (ffebld_cu_ptr_real3 (u),
+		     ffebld_constant_real4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("REAL3/REAL bad source kind type" == NULL);
+		  break;
+		}
+	      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
+
+#if FFETARGET_okCOMPLEX4
+		case FFEINFO_kindtypeREAL4:
+		  error = ffetarget_convert_real3_complex4
+		    (ffebld_cu_ptr_real3 (u),
+		     ffebld_constant_complex4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("REAL3/COMPLEX bad source kind type" == NULL);
+		  break;
+		}
+	      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;
+	    }
+
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_real3_val
+	     (ffebld_cu_val_real3 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okREAL4
+	case FFEINFO_kindtypeREAL4:
+	  switch (ffeinfo_basictype (ffebld_info (l)))
+	    {
+	    case FFEINFO_basictypeINTEGER:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okINTEGER1
+		case FFEINFO_kindtypeINTEGER1:
+		  error = ffetarget_convert_real4_integer1
+		    (ffebld_cu_ptr_real4 (u),
+		     ffebld_constant_integer1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+		case FFEINFO_kindtypeINTEGER2:
+		  error = ffetarget_convert_real4_integer2
+		    (ffebld_cu_ptr_real4 (u),
+		     ffebld_constant_integer2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+		case FFEINFO_kindtypeINTEGER3:
+		  error = ffetarget_convert_real4_integer3
+		    (ffebld_cu_ptr_real4 (u),
+		     ffebld_constant_integer3 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+		case FFEINFO_kindtypeINTEGER4:
+		  error = ffetarget_convert_real4_integer4
+		    (ffebld_cu_ptr_real4 (u),
+		     ffebld_constant_integer4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("REAL4/INTEGER bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeREAL:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okREAL1
+		case FFEINFO_kindtypeREAL1:
+		  error = ffetarget_convert_real4_real1
+		    (ffebld_cu_ptr_real4 (u),
+		     ffebld_constant_real1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okREAL2
+		case FFEINFO_kindtypeREAL2:
+		  error = ffetarget_convert_real4_real2
+		    (ffebld_cu_ptr_real4 (u),
+		     ffebld_constant_real2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okREAL3
+		case FFEINFO_kindtypeREAL3:
+		  error = ffetarget_convert_real4_real3
+		    (ffebld_cu_ptr_real4 (u),
+		     ffebld_constant_real3 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("REAL4/REAL bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeCOMPLEX:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okCOMPLEX1
+		case FFEINFO_kindtypeREAL1:
+		  error = ffetarget_convert_real4_complex1
+		    (ffebld_cu_ptr_real4 (u),
+		     ffebld_constant_complex1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+		case FFEINFO_kindtypeREAL2:
+		  error = ffetarget_convert_real4_complex2
+		    (ffebld_cu_ptr_real4 (u),
+		     ffebld_constant_complex2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+		case FFEINFO_kindtypeREAL3:
+		  error = ffetarget_convert_real4_complex3
+		    (ffebld_cu_ptr_real4 (u),
+		     ffebld_constant_complex3 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+		case FFEINFO_kindtypeREAL4:
+		  error = ffetarget_convert_real4_complex4
+		    (ffebld_cu_ptr_real4 (u),
+		     ffebld_constant_complex4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("REAL4/COMPLEX bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeCHARACTER:
+	      error = ffetarget_convert_real4_character1
+		(ffebld_cu_ptr_real4 (u),
+		 ffebld_constant_character1 (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeHOLLERITH:
+	      error = ffetarget_convert_real4_hollerith
+		(ffebld_cu_ptr_real4 (u),
+		 ffebld_constant_hollerith (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeTYPELESS:
+	      error = ffetarget_convert_real4_typeless
+		(ffebld_cu_ptr_real4 (u),
+		 ffebld_constant_typeless (ffebld_conter (l)));
+	      break;
+
+	    default:
+	      assert ("REAL4 bad type" == NULL);
+	      break;
+	    }
+
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_real4_val
+	     (ffebld_cu_val_real4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad real kind type" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okREAL4
+		case FFEINFO_kindtypeREAL4:
+		  error = ffetarget_convert_complex1_real4
+		    (ffebld_cu_ptr_complex1 (u),
+		     ffebld_constant_real4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("COMPLEX1/REAL bad source kind type" == NULL);
+		  break;
+		}
+	      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
+
+#if FFETARGET_okCOMPLEX4
+		case FFEINFO_kindtypeREAL4:
+		  error = ffetarget_convert_complex1_complex4
+		    (ffebld_cu_ptr_complex1 (u),
+		     ffebld_constant_complex4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("COMPLEX1/COMPLEX bad source kind type" == NULL);
+		  break;
+		}
+	      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;
+	    }
+
+	  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
+
+#if FFETARGET_okREAL4
+		case FFEINFO_kindtypeREAL4:
+		  error = ffetarget_convert_complex2_real4
+		    (ffebld_cu_ptr_complex2 (u),
+		     ffebld_constant_real4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("COMPLEX2/REAL bad source kind type" == NULL);
+		  break;
+		}
+	      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
+
+#if FFETARGET_okCOMPLEX4
+		case FFEINFO_kindtypeREAL4:
+		  error = ffetarget_convert_complex2_complex4
+		    (ffebld_cu_ptr_complex2 (u),
+		     ffebld_constant_complex4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("COMPLEX2/COMPLEX bad source kind type" == NULL);
+		  break;
+		}
+	      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;
+	    }
+
+	  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
+
+#if FFETARGET_okREAL4
+		case FFEINFO_kindtypeREAL4:
+		  error = ffetarget_convert_complex3_real4
+		    (ffebld_cu_ptr_complex3 (u),
+		     ffebld_constant_real4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("COMPLEX3/REAL bad source kind type" == NULL);
+		  break;
+		}
+	      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
+
+#if FFETARGET_okCOMPLEX4
+		case FFEINFO_kindtypeREAL4:
+		  error = ffetarget_convert_complex3_complex4
+		    (ffebld_cu_ptr_complex3 (u),
+		     ffebld_constant_complex4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("COMPLEX3/COMPLEX bad source kind type" == NULL);
+		  break;
+		}
+	      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;
+	    }
+
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_complex3_val
+	     (ffebld_cu_val_complex3 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+	case FFEINFO_kindtypeREAL4:
+	  switch (ffeinfo_basictype (ffebld_info (l)))
+	    {
+	    case FFEINFO_basictypeINTEGER:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okINTEGER1
+		case FFEINFO_kindtypeINTEGER1:
+		  error = ffetarget_convert_complex4_integer1
+		    (ffebld_cu_ptr_complex4 (u),
+		     ffebld_constant_integer1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+		case FFEINFO_kindtypeINTEGER2:
+		  error = ffetarget_convert_complex4_integer2
+		    (ffebld_cu_ptr_complex4 (u),
+		     ffebld_constant_integer2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+		case FFEINFO_kindtypeINTEGER3:
+		  error = ffetarget_convert_complex4_integer3
+		    (ffebld_cu_ptr_complex4 (u),
+		     ffebld_constant_integer3 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+		case FFEINFO_kindtypeINTEGER4:
+		  error = ffetarget_convert_complex4_integer4
+		    (ffebld_cu_ptr_complex4 (u),
+		     ffebld_constant_integer4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("COMPLEX4/INTEGER bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeREAL:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okREAL1
+		case FFEINFO_kindtypeREAL1:
+		  error = ffetarget_convert_complex4_real1
+		    (ffebld_cu_ptr_complex4 (u),
+		     ffebld_constant_real1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okREAL2
+		case FFEINFO_kindtypeREAL2:
+		  error = ffetarget_convert_complex4_real2
+		    (ffebld_cu_ptr_complex4 (u),
+		     ffebld_constant_real2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okREAL3
+		case FFEINFO_kindtypeREAL3:
+		  error = ffetarget_convert_complex4_real3
+		    (ffebld_cu_ptr_complex4 (u),
+		     ffebld_constant_real3 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okREAL4
+		case FFEINFO_kindtypeREAL4:
+		  error = ffetarget_convert_complex4_real4
+		    (ffebld_cu_ptr_complex4 (u),
+		     ffebld_constant_real4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("COMPLEX4/REAL bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeCOMPLEX:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okCOMPLEX1
+		case FFEINFO_kindtypeREAL1:
+		  error = ffetarget_convert_complex4_complex1
+		    (ffebld_cu_ptr_complex4 (u),
+		     ffebld_constant_complex1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+		case FFEINFO_kindtypeREAL2:
+		  error = ffetarget_convert_complex4_complex2
+		    (ffebld_cu_ptr_complex4 (u),
+		     ffebld_constant_complex2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+		case FFEINFO_kindtypeREAL3:
+		  error = ffetarget_convert_complex4_complex3
+		    (ffebld_cu_ptr_complex4 (u),
+		     ffebld_constant_complex3 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("COMPLEX4/COMPLEX bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeCHARACTER:
+	      error = ffetarget_convert_complex4_character1
+		(ffebld_cu_ptr_complex4 (u),
+		 ffebld_constant_character1 (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeHOLLERITH:
+	      error = ffetarget_convert_complex4_hollerith
+		(ffebld_cu_ptr_complex4 (u),
+		 ffebld_constant_hollerith (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeTYPELESS:
+	      error = ffetarget_convert_complex4_typeless
+		(ffebld_cu_ptr_complex4 (u),
+		 ffebld_constant_typeless (ffebld_conter (l)));
+	      break;
+
+	    default:
+	      assert ("COMPLEX4 bad type" == NULL);
+	      break;
+	    }
+
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_complex4_val
+	     (ffebld_cu_val_complex4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad complex kind type" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okREAL4
+	case FFEINFO_kindtypeREAL4:
+	  error = ffetarget_uminus_real4 (ffebld_cu_ptr_real4 (u),
+				 ffebld_constant_real4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real4_val
+					   (ffebld_cu_val_real4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad real kind type" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okCOMPLEX4
+	case FFEINFO_kindtypeREAL4:
+	  error = ffetarget_uminus_complex4 (ffebld_cu_ptr_complex4 (u),
+			      ffebld_constant_complex4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex4_val
+					(ffebld_cu_val_complex4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad complex kind type" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okREAL4
+	case FFEINFO_kindtypeREAL4:
+	  error = ffetarget_add_real4 (ffebld_cu_ptr_real4 (u),
+				  ffebld_constant_real4 (ffebld_conter (l)),
+				 ffebld_constant_real4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real4_val
+					   (ffebld_cu_val_real4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad real kind type" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okCOMPLEX4
+	case FFEINFO_kindtypeREAL4:
+	  error = ffetarget_add_complex4 (ffebld_cu_ptr_complex4 (u),
+			       ffebld_constant_complex4 (ffebld_conter (l)),
+			      ffebld_constant_complex4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex4_val
+					(ffebld_cu_val_complex4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad complex kind type" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okREAL4
+	case FFEINFO_kindtypeREAL4:
+	  error = ffetarget_subtract_real4 (ffebld_cu_ptr_real4 (u),
+				  ffebld_constant_real4 (ffebld_conter (l)),
+				 ffebld_constant_real4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real4_val
+					   (ffebld_cu_val_real4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad real kind type" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okCOMPLEX4
+	case FFEINFO_kindtypeREAL4:
+	  error = ffetarget_subtract_complex4 (ffebld_cu_ptr_complex4 (u),
+			       ffebld_constant_complex4 (ffebld_conter (l)),
+			      ffebld_constant_complex4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex4_val
+					(ffebld_cu_val_complex4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad complex kind type" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okREAL4
+	case FFEINFO_kindtypeREAL4:
+	  error = ffetarget_multiply_real4 (ffebld_cu_ptr_real4 (u),
+				  ffebld_constant_real4 (ffebld_conter (l)),
+				 ffebld_constant_real4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real4_val
+					   (ffebld_cu_val_real4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad real kind type" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okCOMPLEX4
+	case FFEINFO_kindtypeREAL4:
+	  error = ffetarget_multiply_complex4 (ffebld_cu_ptr_complex4 (u),
+			       ffebld_constant_complex4 (ffebld_conter (l)),
+			      ffebld_constant_complex4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex4_val
+					(ffebld_cu_val_complex4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad complex kind type" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okREAL4
+	case FFEINFO_kindtypeREAL4:
+	  error = ffetarget_divide_real4 (ffebld_cu_ptr_real4 (u),
+				  ffebld_constant_real4 (ffebld_conter (l)),
+				 ffebld_constant_real4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real4_val
+					   (ffebld_cu_val_real4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad real kind type" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okCOMPLEX4
+	case FFEINFO_kindtypeREAL4:
+	  error = ffetarget_divide_complex4 (ffebld_cu_ptr_complex4 (u),
+			       ffebld_constant_complex4 (ffebld_conter (l)),
+			      ffebld_constant_complex4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex4_val
+					(ffebld_cu_val_complex4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad complex kind type" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okCHARACTER2
+	case FFEINFO_kindtypeCHARACTER2:
+	  error = ffetarget_concatenate_character2 (ffebld_cu_ptr_character2 (u),
+			     ffebld_constant_character2 (ffebld_conter (l)),
+			     ffebld_constant_character2 (ffebld_conter (r)),
+				   ffebld_constant_pool (), &len);
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_character2_val
+				      (ffebld_cu_val_character2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+	case FFEINFO_kindtypeCHARACTER3:
+	  error = ffetarget_concatenate_character3 (ffebld_cu_ptr_character3 (u),
+			     ffebld_constant_character3 (ffebld_conter (l)),
+			     ffebld_constant_character3 (ffebld_conter (r)),
+				   ffebld_constant_pool (), &len);
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_character3_val
+				      (ffebld_cu_val_character3 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+	case FFEINFO_kindtypeCHARACTER4:
+	  error = ffetarget_concatenate_character4 (ffebld_cu_ptr_character4 (u),
+			     ffebld_constant_character4 (ffebld_conter (l)),
+			     ffebld_constant_character4 (ffebld_conter (r)),
+				   ffebld_constant_pool (), &len);
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_character4_val
+				      (ffebld_cu_val_character4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad character kind type" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okREAL4
+	case FFEINFO_kindtypeREAL4:
+	  error = ffetarget_eq_real4 (&val,
+				  ffebld_constant_real4 (ffebld_conter (l)),
+				 ffebld_constant_real4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad real kind type" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okCOMPLEX4
+	case FFEINFO_kindtypeREAL4:
+	  error = ffetarget_eq_complex4 (&val,
+			       ffebld_constant_complex4 (ffebld_conter (l)),
+			      ffebld_constant_complex4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad complex kind type" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okCHARACTER2
+	case FFEINFO_kindtypeCHARACTER2:
+	  error = ffetarget_eq_character2 (&val,
+			     ffebld_constant_character2 (ffebld_conter (l)),
+			    ffebld_constant_character2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+	case FFEINFO_kindtypeCHARACTER3:
+	  error = ffetarget_eq_character3 (&val,
+			     ffebld_constant_character3 (ffebld_conter (l)),
+			    ffebld_constant_character3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+	case FFEINFO_kindtypeCHARACTER4:
+	  error = ffetarget_eq_character4 (&val,
+			     ffebld_constant_character4 (ffebld_conter (l)),
+			    ffebld_constant_character4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad character kind type" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okREAL4
+	case FFEINFO_kindtypeREAL4:
+	  error = ffetarget_ne_real4 (&val,
+				  ffebld_constant_real4 (ffebld_conter (l)),
+				 ffebld_constant_real4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad real kind type" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okCOMPLEX4
+	case FFEINFO_kindtypeREAL4:
+	  error = ffetarget_ne_complex4 (&val,
+			       ffebld_constant_complex4 (ffebld_conter (l)),
+			      ffebld_constant_complex4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad complex kind type" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okCHARACTER2
+	case FFEINFO_kindtypeCHARACTER2:
+	  error = ffetarget_ne_character2 (&val,
+			     ffebld_constant_character2 (ffebld_conter (l)),
+			    ffebld_constant_character2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+	case FFEINFO_kindtypeCHARACTER3:
+	  error = ffetarget_ne_character3 (&val,
+			     ffebld_constant_character3 (ffebld_conter (l)),
+			    ffebld_constant_character3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+	case FFEINFO_kindtypeCHARACTER4:
+	  error = ffetarget_ne_character4 (&val,
+			     ffebld_constant_character4 (ffebld_conter (l)),
+			    ffebld_constant_character4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad character kind type" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okREAL4
+	case FFEINFO_kindtypeREAL4:
+	  error = ffetarget_ge_real4 (&val,
+				  ffebld_constant_real4 (ffebld_conter (l)),
+				 ffebld_constant_real4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad real kind type" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okCHARACTER2
+	case FFEINFO_kindtypeCHARACTER2:
+	  error = ffetarget_ge_character2 (&val,
+			     ffebld_constant_character2 (ffebld_conter (l)),
+			    ffebld_constant_character2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+	case FFEINFO_kindtypeCHARACTER3:
+	  error = ffetarget_ge_character3 (&val,
+			     ffebld_constant_character3 (ffebld_conter (l)),
+			    ffebld_constant_character3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+	case FFEINFO_kindtypeCHARACTER4:
+	  error = ffetarget_ge_character4 (&val,
+			     ffebld_constant_character4 (ffebld_conter (l)),
+			    ffebld_constant_character4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad character kind type" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okREAL4
+	case FFEINFO_kindtypeREAL4:
+	  error = ffetarget_gt_real4 (&val,
+				  ffebld_constant_real4 (ffebld_conter (l)),
+				 ffebld_constant_real4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad real kind type" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okCHARACTER2
+	case FFEINFO_kindtypeCHARACTER2:
+	  error = ffetarget_gt_character2 (&val,
+			     ffebld_constant_character2 (ffebld_conter (l)),
+			    ffebld_constant_character2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+	case FFEINFO_kindtypeCHARACTER3:
+	  error = ffetarget_gt_character3 (&val,
+			     ffebld_constant_character3 (ffebld_conter (l)),
+			    ffebld_constant_character3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+	case FFEINFO_kindtypeCHARACTER4:
+	  error = ffetarget_gt_character4 (&val,
+			     ffebld_constant_character4 (ffebld_conter (l)),
+			    ffebld_constant_character4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad character kind type" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okREAL4
+	case FFEINFO_kindtypeREAL4:
+	  error = ffetarget_le_real4 (&val,
+				  ffebld_constant_real4 (ffebld_conter (l)),
+				 ffebld_constant_real4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad real kind type" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okCHARACTER2
+	case FFEINFO_kindtypeCHARACTER2:
+	  error = ffetarget_le_character2 (&val,
+			     ffebld_constant_character2 (ffebld_conter (l)),
+			    ffebld_constant_character2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+	case FFEINFO_kindtypeCHARACTER3:
+	  error = ffetarget_le_character3 (&val,
+			     ffebld_constant_character3 (ffebld_conter (l)),
+			    ffebld_constant_character3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+	case FFEINFO_kindtypeCHARACTER4:
+	  error = ffetarget_le_character4 (&val,
+			     ffebld_constant_character4 (ffebld_conter (l)),
+			    ffebld_constant_character4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad character kind type" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okREAL4
+	case FFEINFO_kindtypeREAL4:
+	  error = ffetarget_lt_real4 (&val,
+				  ffebld_constant_real4 (ffebld_conter (l)),
+				 ffebld_constant_real4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad real kind type" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okCHARACTER2
+	case FFEINFO_kindtypeCHARACTER2:
+	  error = ffetarget_lt_character2 (&val,
+			     ffebld_constant_character2 (ffebld_conter (l)),
+			    ffebld_constant_character2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+	case FFEINFO_kindtypeCHARACTER3:
+	  error = ffetarget_lt_character3 (&val,
+			     ffebld_constant_character3 (ffebld_conter (l)),
+			    ffebld_constant_character3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+	case FFEINFO_kindtypeCHARACTER4:
+	  error = ffetarget_lt_character4 (&val,
+			     ffebld_constant_character4 (ffebld_conter (l)),
+			    ffebld_constant_character4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad character kind type" == NULL);
+	  break;
+	}
+      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
+
+#if FFETARGET_okCHARACTER2
+	case FFEINFO_kindtypeCHARACTER2:
+	  error = ffetarget_substr_character2 (ffebld_cu_ptr_character2 (u),
+		ffebld_constant_character2 (ffebld_conter (l)), first, last,
+				   ffebld_constant_pool (), &len);
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_character2_val
+				      (ffebld_cu_val_character2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+	case FFEINFO_kindtypeCHARACTER3:
+	  error = ffetarget_substr_character3 (ffebld_cu_ptr_character3 (u),
+		ffebld_constant_character3 (ffebld_conter (l)), first, last,
+				   ffebld_constant_pool (), &len);
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_character3_val
+				      (ffebld_cu_val_character3 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+	case FFEINFO_kindtypeCHARACTER4:
+	  error = ffetarget_substr_character4 (ffebld_cu_ptr_character4 (u),
+		ffebld_constant_character4 (ffebld_conter (l)), first, last,
+				   ffebld_constant_pool (), &len);
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_character4_val
+				      (ffebld_cu_val_character4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad character kind type" == NULL);
+	  break;
+	}
+      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 ()
+{
+  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 = ffeinfo_basictype (ffebld_info (ffeexpr_stack_->expr));
+  ffeinfoBasictype rty = ffeinfo_basictype (ffebld_info (expr));
+  ffeinfoKindtype lkt;
+  ffeinfoKindtype rkt;
+  ffeinfoKindtype nkt;
+  bool ok = TRUE;
+  ffebld orig;
+
+  if ((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
+
+#if FFETARGET_okCOMPLEX4
+    case FFEINFO_kindtypeREAL4:
+      e->u.operand = ffebld_new_conter (ffebld_constant_new_complex4
+	      (ffebld_conter (ffeexpr_stack_->expr), ffebld_conter (expr)));
+      ffebld_set_info (e->u.operand,
+		       ffeinfo_new (FFEINFO_basictypeCOMPLEX, nkt, 0,
+				  FFEINFO_kindENTITY, FFEINFO_whereCONSTANT,
+				    FFETARGET_charactersizeNONE));
+      break;
+#endif
+
+    default:
+      if (ffebad_start ((nkt == FFEINFO_kindtypeREALDOUBLE)
+			? FFEBAD_BAD_DBLCMPLX : FFEBAD_BAD_COMPLEX))
+	{
+	  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_dotdot_ -- Look up name in list of .FOO. possibilities
+
+   ffeexprDotdot_ d;
+   ffelexToken t;
+   d = ffeexpr_dotdot_(t);
+
+   Returns the identifier for the name, or the NONE identifier.	 */
+
+static ffeexprDotdot_
+ffeexpr_dotdot_ (ffelexToken t)
+{
+  char *p;
+
+  switch (ffelex_token_length (t))
+    {
+    case 2:
+      switch (*(p = ffelex_token_text (t)))
+	{
+	case FFESRC_CASE_MATCH_INIT ('E', 'e', match_2e, no_match_2):
+	  if (ffesrc_char_match_noninit (*++p, 'Q', 'q'))
+	    return FFEEXPR_dotdotEQ_;
+	  return FFEEXPR_dotdotNONE_;
+
+	case FFESRC_CASE_MATCH_INIT ('G', 'g', match_2g, no_match_2):
+	  if (ffesrc_char_match_noninit (*++p, 'E', 'e'))
+	    return FFEEXPR_dotdotGE_;
+	  if (ffesrc_char_match_noninit (*p, 'T', 't'))
+	    return FFEEXPR_dotdotGT_;
+	  return FFEEXPR_dotdotNONE_;
+
+	case FFESRC_CASE_MATCH_INIT ('L', 'l', match_2l, no_match_2):
+	  if (ffesrc_char_match_noninit (*++p, 'E', 'e'))
+	    return FFEEXPR_dotdotLE_;
+	  if (ffesrc_char_match_noninit (*p, 'T', 't'))
+	    return FFEEXPR_dotdotLT_;
+	  return FFEEXPR_dotdotNONE_;
+
+	case FFESRC_CASE_MATCH_INIT ('N', 'n', match_2n, no_match_2):
+	  if (ffesrc_char_match_noninit (*++p, 'E', 'e'))
+	    return FFEEXPR_dotdotNE_;
+	  return FFEEXPR_dotdotNONE_;
+
+	case FFESRC_CASE_MATCH_INIT ('O', 'o', match_2o, no_match_2):
+	  if (ffesrc_char_match_noninit (*++p, 'R', 'r'))
+	    return FFEEXPR_dotdotOR_;
+	  return FFEEXPR_dotdotNONE_;
+
+	default:
+	no_match_2:		/* :::::::::::::::::::: */
+	  return FFEEXPR_dotdotNONE_;
+	}
+
+    case 3:
+      switch (*(p = ffelex_token_text (t)))
+	{
+	case FFESRC_CASE_MATCH_INIT ('A', 'a', match_3a, no_match_3):
+	  if ((ffesrc_char_match_noninit (*++p, 'N', 'n'))
+	      && (ffesrc_char_match_noninit (*++p, 'D', 'd')))
+	    return FFEEXPR_dotdotAND_;
+	  return FFEEXPR_dotdotNONE_;
+
+	case FFESRC_CASE_MATCH_INIT ('E', 'e', match_3e, no_match_3):
+	  if ((ffesrc_char_match_noninit (*++p, 'Q', 'q'))
+	      && (ffesrc_char_match_noninit (*++p, 'V', 'v')))
+	    return FFEEXPR_dotdotEQV_;
+	  return FFEEXPR_dotdotNONE_;
+
+	case FFESRC_CASE_MATCH_INIT ('N', 'n', match_3n, no_match_3):
+	  if ((ffesrc_char_match_noninit (*++p, 'O', 'o'))
+	      && (ffesrc_char_match_noninit (*++p, 'T', 't')))
+	    return FFEEXPR_dotdotNOT_;
+	  return FFEEXPR_dotdotNONE_;
+
+	case FFESRC_CASE_MATCH_INIT ('X', 'x', match_3x, no_match_3):
+	  if ((ffesrc_char_match_noninit (*++p, 'O', 'o'))
+	      && (ffesrc_char_match_noninit (*++p, 'R', 'r')))
+	    return FFEEXPR_dotdotXOR_;
+	  return FFEEXPR_dotdotNONE_;
+
+	default:
+	no_match_3:		/* :::::::::::::::::::: */
+	  return FFEEXPR_dotdotNONE_;
+	}
+
+    case 4:
+      switch (*(p = ffelex_token_text (t)))
+	{
+	case FFESRC_CASE_MATCH_INIT ('N', 'n', match_4n, no_match_4):
+	  if ((ffesrc_char_match_noninit (*++p, 'E', 'e'))
+	      && (ffesrc_char_match_noninit (*++p, 'Q', 'q'))
+	      && (ffesrc_char_match_noninit (*++p, 'V', 'v')))
+	    return FFEEXPR_dotdotNEQV_;
+	  return FFEEXPR_dotdotNONE_;
+
+	case FFESRC_CASE_MATCH_INIT ('T', 't', match_4t, no_match_4):
+	  if ((ffesrc_char_match_noninit (*++p, 'R', 'r'))
+	      && (ffesrc_char_match_noninit (*++p, 'U', 'u'))
+	      && (ffesrc_char_match_noninit (*++p, 'E', 'e')))
+	    return FFEEXPR_dotdotTRUE_;
+	  return FFEEXPR_dotdotNONE_;
+
+	default:
+	no_match_4:		/* :::::::::::::::::::: */
+	  return FFEEXPR_dotdotNONE_;
+	}
+
+    case 5:
+      if (ffesrc_strcmp_2c (ffe_case_match (), ffelex_token_text (t), "FALSE",
+			    "false", "False")
+	  == 0)
+	return FFEEXPR_dotdotFALSE_;
+      return FFEEXPR_dotdotNONE_;
+
+    default:
+      return FFEEXPR_dotdotNONE_;
+    }
+}
+
+/* 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)
+{
+  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
+#if FFETARGET_okCOMPLEX4
+	case FFEINFO_kindtypeREAL4:
+#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_ ()
+{
+  ffeexprExpr_ e;
+
+  e = (ffeexprExpr_) 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;
+
+		case FFEBLD_opPERCENT_LOC:
+		  as = FFEGLOBAL_argsummaryPTR;
+		  break;
+
+		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 ((ffebld_op (ffebld_left (item)) == FFEBLD_opSYMTER)
+		      && (ffesymbol_specific (ffebld_symter (ffebld_left (item)))
+			  == FFEINTRIN_specLOC))
+		    {
+		      as = FFEGLOBAL_argsummaryPTR;
+		      break;
+		    }
+		  /* 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_ (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);
+#ifdef WEIRD_NONFORTRAN_RULES
+  if ((ffeexpr_stack_->exprstack != NULL)
+      && (ffeexpr_stack_->exprstack->expr->type == FFEEXPR_exprtypeBINARY_)
+      && (ffeexpr_stack_->exprstack->expr->u.operator.prec
+	  == FFEEXPR_operatorprecedenceHIGHEST_)
+      && (ffeexpr_stack_->exprstack->expr->u.operator.as
+	  == FFEEXPR_operatorassociativityL2R_))
+    ffeexpr_reduce_ ();
+#endif
+}
+
+/* ffeexpr_exprstack_push_unary_ -- Push a unary operator onto the stack
+
+   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_))
+    {
+      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))
+    {
+      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_ ()
+{
+  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;
+
+  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);
+	  reduced = ffeexpr_reduced_bool2_ (reduced, left_operand, operator,
+					    operand);
+	  reduced = ffeexpr_collapse_and (reduced, operator->token);
+	  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);
+	  reduced = ffeexpr_reduced_bool2_ (reduced, left_operand, operator,
+					    operand);
+	  reduced = ffeexpr_collapse_or (reduced, operator->token);
+	  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);
+	  reduced = ffeexpr_reduced_bool2_ (reduced, left_operand, operator,
+					    operand);
+	  reduced = ffeexpr_collapse_xor (reduced, operator->token);
+	  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);
+	  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);
+	  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))
+	{
+	  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))
+	{
+	  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))
+    {
+      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) && (lbt != 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)
+	{
+	  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)
+	  && (lbt != 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)
+{
+  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. */
+    }
+
+  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_ = ffeexpr_dotdot_ (t);
+      switch (ffeexpr_current_dotdot_)
+	{
+	case FFEEXPR_dotdotNONE_:
+	  return (ffelexHandler) ffeexpr_nil_rhs_ (t);
+
+	case FFEEXPR_dotdotTRUE_:
+	case FFEEXPR_dotdotFALSE_:
+	case FFEEXPR_dotdotNOT_:
+	  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 FFEEXPR_dotdotNOT_:
+      if (ffelex_token_type (t) != FFELEX_typePERIOD)
+	return (ffelexHandler) ffeexpr_nil_rhs_ (t);
+      return (ffelexHandler) ffeexpr_nil_rhs_;
+
+    case FFEEXPR_dotdotTRUE_:
+    case FFEEXPR_dotdotFALSE_:
+      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;
+  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;
+  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;
+  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;
+  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_ = ffeexpr_dotdot_ (t);
+      switch (ffeexpr_current_dotdot_)
+	{
+	case FFEEXPR_dotdotTRUE_:
+	case FFEEXPR_dotdotFALSE_:
+	case FFEEXPR_dotdotNOT_:
+	  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) && ffe_is_pedantic ())
+	|| ((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_:
+    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;			/* expr==NULL ok for substring; element case
+				   caught by callback. */
+
+    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:
+	  error = 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_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:
+	  error = error
+	    && (ffeinfo_kindtype (info) != FFEINFO_kindtypeLOGICALDEFAULT);
+	  if (!ffeexpr_stack_->is_rhs)
+	    break;		/* Don't convert lhs variable. */
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  break;
+
+	case FFEINFO_basictypeINTEGER:
+	  error = error &&
+	    (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT);
+	  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:
+	  error = FALSE;
+	  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. */
+		: (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_ = ffeexpr_dotdot_ (t);
+      switch (ffeexpr_current_dotdot_)
+	{
+	case FFEEXPR_dotdotNONE_:
+	  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 FFEEXPR_dotdotTRUE_:
+	case FFEEXPR_dotdotFALSE_:
+	case FFEEXPR_dotdotNOT_:
+	  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 FFEEXPR_dotdotNOT_:
+      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 FFEEXPR_dotdotTRUE_:
+      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 FFEEXPR_dotdotFALSE_:
+      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;
+  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;
+  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. */
+
+  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);
+  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;
+  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;
+  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_ = ffeexpr_dotdot_ (t);
+      switch (ffeexpr_current_dotdot_)
+	{
+	case FFEEXPR_dotdotTRUE_:
+	case FFEEXPR_dotdotFALSE_:
+	case FFEEXPR_dotdotNOT_:
+	  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_;
+
+	case FFEEXPR_dotdotNONE_:
+	  if (ffest_ffebad_start (FFEBAD_INVALID_DOTDOT))
+	    {
+	      ffebad_string (ffelex_token_text (t));
+	      ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+			   ffelex_token_where_column (ffeexpr_tokens_[0]));
+	      ffebad_finish ();
+	    }
+	  ffeexpr_current_dotdot_ = FFEEXPR_dotdotEQ_;
+	  /* Fall through here, pretending we got a .EQ. operator. */
+	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;
+
+  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. */
+
+  e = ffeexpr_expr_new_ ();
+  e->type = FFEEXPR_exprtypeBINARY_;
+  e->token = ffeexpr_tokens_[0];
+
+  switch (ffeexpr_current_dotdot_)
+    {
+    case FFEEXPR_dotdotAND_:
+      e->u.operator.op = FFEEXPR_operatorAND_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceAND_;
+      e->u.operator.as = FFEEXPR_operatorassociativityAND_;
+      break;
+
+    case FFEEXPR_dotdotOR_:
+      e->u.operator.op = FFEEXPR_operatorOR_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceOR_;
+      e->u.operator.as = FFEEXPR_operatorassociativityOR_;
+      break;
+
+    case FFEEXPR_dotdotXOR_:
+      e->u.operator.op = FFEEXPR_operatorXOR_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceXOR_;
+      e->u.operator.as = FFEEXPR_operatorassociativityXOR_;
+      break;
+
+    case FFEEXPR_dotdotEQV_:
+      e->u.operator.op = FFEEXPR_operatorEQV_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceEQV_;
+      e->u.operator.as = FFEEXPR_operatorassociativityEQV_;
+      break;
+
+    case FFEEXPR_dotdotNEQV_:
+      e->u.operator.op = FFEEXPR_operatorNEQV_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceNEQV_;
+      e->u.operator.as = FFEEXPR_operatorassociativityNEQV_;
+      break;
+
+    case FFEEXPR_dotdotLT_:
+      e->u.operator.op = FFEEXPR_operatorLT_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceLT_;
+      e->u.operator.as = FFEEXPR_operatorassociativityLT_;
+      break;
+
+    case FFEEXPR_dotdotLE_:
+      e->u.operator.op = FFEEXPR_operatorLE_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceLE_;
+      e->u.operator.as = FFEEXPR_operatorassociativityLE_;
+      break;
+
+    case FFEEXPR_dotdotEQ_:
+      e->u.operator.op = FFEEXPR_operatorEQ_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceEQ_;
+      e->u.operator.as = FFEEXPR_operatorassociativityEQ_;
+      break;
+
+    case FFEEXPR_dotdotNE_:
+      e->u.operator.op = FFEEXPR_operatorNE_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceNE_;
+      e->u.operator.as = FFEEXPR_operatorassociativityNE_;
+      break;
+
+    case FFEEXPR_dotdotGT_:
+      e->u.operator.op = FFEEXPR_operatorGT_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceGT_;
+      e->u.operator.as = FFEEXPR_operatorassociativityGT_;
+      break;
+
+    case FFEEXPR_dotdotGE_:
+      e->u.operator.op = FFEEXPR_operatorGE_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceGE_;
+      e->u.operator.as = FFEEXPR_operatorassociativityGE_;
+      break;
+
+    default:
+      assert ("Bad unary dotdot in ffeexpr_current_dotdot_" == NULL);
+    }
+
+  ffeexpr_exprstack_push_binary_ (e);
+
+  if (ffelex_token_type (t) != FFELEX_typePERIOD)
+    return (ffelexHandler) ffeexpr_token_rhs_ (t);
+  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
+
+    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);
+	  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_kindtype (sp) != FFEINFO_kindtypeINTEGERDEFAULT)
+	  && (ffesymbol_kindtype (sp) != FFEINFO_kindtypeANY)))
+    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_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);
+	  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);
+
+  if (ffeinfo_where (info) == FFEINFO_whereCONSTANT)
+    {				/* Statement function (or subroutine, if
+				   there was such a thing). */
+      if ((expr == NULL)
+	  && ((ffe_is_pedantic ()
+	       && (ffeexpr_stack_->expr != NULL))
+	      || (ffelex_token_type (t) == FFELEX_typeCOMMA)))
+	{
+	  if (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 (ffeexpr_stack_->next_dummy != NULL)
+	    {			/* Don't bother if we're going to complain
+				   later! */
+	      expr = ffebld_new_conter
+		(ffebld_constant_new_integerdefault_val (0));
+	      ffebld_set_info (expr, ffeinfo_new_any ());
+	    }
+	}
+
+      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)
+		{
+		  if (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_ugly_comma ()
+	   || (ffelex_token_type (t) == FFELEX_typeCOMMA))
+    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->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)
+	    {
+	      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;
+
+  string = ffeexpr_stack_->exprstack;
+  strop = string->u.operand;
+  info = ffebld_info (strop);
+
+  if ((first == NULL) || (ffebld_op (first) == FFEBLD_opCONTER))
+    {				/* The starting point is known. */
+      first_val = (first == NULL) ? 1
+	: ffebld_constant_integerdefault (ffebld_conter (first));
+    }
+  else
+    {				/* Assume start of the entity. */
+      first_val = 1;
+    }
+
+  if ((last != NULL) && (ffebld_op (last) == FFEBLD_opCONTER))
+    {				/* The ending point is known. */
+      last_val = ffebld_constant_integerdefault (ffebld_conter (last));
+
+      if ((first == NULL) || (ffebld_op (first) == FFEBLD_opCONTER))
+	{			/* 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 ()
+{
+  assert (ffeexpr_stack_ == NULL);
+  assert (ffeexpr_level_ == 0);
+}
diff --git a/gcc/f/expr.h b/gcc/f/expr.h
new file mode 100644
index 00000000000..db7d9fa78e7
--- /dev/null
+++ b/gcc/f/expr.h
@@ -0,0 +1,194 @@
+/* expr.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_expr
+#define _H_f_expr
+
+/* 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
diff --git a/gcc/f/fini.c b/gcc/f/fini.c
new file mode 100644
index 00000000000..6e324b64602
--- /dev/null
+++ b/gcc/f/fini.c
@@ -0,0 +1,774 @@
+/* fini.c
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 <ctype.h>
+#include "malloc.h"
+
+#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 char *spaces[]
+=
+{
+  "",				/* 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);
+
+void
+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;
+
+  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");
+      exit (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);
+      exit (1);
+    }
+  out = fopen (output_name, "w");
+  if (out == NULL)
+    {
+      fclose (in);
+      fprintf (stderr, "Cannot open \"%s\"\n", output_name);
+      exit (1);
+    }
+  incl = fopen (include_name, "w");
+  if (incl == NULL)
+    {
+      fclose (in);
+      fprintf (stderr, "Cannot open \"%s\"\n", include_name);
+      exit (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);
+	  exit (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 = (name) malloc (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];
+	  if (isascii (cc) && isalpha (cc))
+	    {
+	      newname->name_uc[i] = toupper (cc);
+	      newname->name_lc[i] = tolower (cc);
+	      newname->name_ic[i] = cc;
+	    }
+	  else
+	    newname->name_uc[i] = newname->name_lc[i] = 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)
+    exit (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);
+  exit (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 (spaces));
+
+  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\
+",
+	     spaces[indent - 2]);
+
+  fprintf (out,
+	   "\
+%sif ((c = ffesrc_strcmp_2c (ffe_case_match (), p, \"%s\", \"%s\", \"%s\")) == 0)\n\
+%sreturn %s%s%s;\n\
+",
+	   spaces[indent], nhalf->name_uc, nhalf->name_lc, nhalf->name_ic,
+	   spaces[indent + 2], prefix, nhalf->kwname, postfix);
+
+  if (num != 1)
+    {
+      fprintf (out,
+	       "\
+%selse if (c < 0)\n\
+",
+	       spaces[indent]);
+
+      if (numhalf == 0)
+	fprintf (out,
+		 "\
+%s;\n\
+",
+		 spaces[indent + 2]);
+      else
+	testname (TRUE, indent + 4, first, nhalf->previous);
+
+      if (num - numhalf > 1)
+	{
+	  fprintf (out,
+		   "\
+%selse\n\
+",
+		   spaces[indent]);
+
+	  testname (TRUE, indent + 4, nhalf->next, last);
+	}
+    }
+
+  if (nested)
+    fprintf (out,
+	     "\
+%s}\n\
+",
+	     spaces[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 (spaces));
+
+  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\
+",
+	     spaces[indent - 2]);
+
+  fprintf (out,
+	   "\
+%sif ((c = ffesrc_strncmp_2c (ffe_case_match (), p, \"%s\", \"%s\", \"%s\", %d)) == 0)\n\
+%sreturn %s%s%s;\n\
+",
+	   spaces[indent], nhalf->name_uc, nhalf->name_lc, nhalf->name_ic,
+	   len, spaces[indent + 2], prefix, nhalf->kwname, postfix);
+
+  if (num != 1)
+    {
+      fprintf (out,
+	       "\
+%selse if (c < 0)\n\
+",
+	       spaces[indent]);
+
+      if (numhalf == 0)
+	fprintf (out,
+		 "\
+%s;\n\
+",
+		 spaces[indent + 2]);
+      else
+	testnames (TRUE, indent + 4, len, first, nhalf->previous);
+
+      if (num - numhalf > 1)
+	{
+	  fprintf (out,
+		   "\
+%selse\n\
+",
+		   spaces[indent]);
+
+	  testnames (TRUE, indent + 4, len, nhalf->next, last);
+	}
+    }
+
+  if (nested)
+    fprintf (out,
+	     "\
+%s}\n\
+",
+	     spaces[indent - 2]);
+}
diff --git a/gcc/f/flags.j b/gcc/f/flags.j
new file mode 100644
index 00000000000..67966b9448e
--- /dev/null
+++ b/gcc/f/flags.j
@@ -0,0 +1,27 @@
+/* flags.j -- Wrapper for GCC's flags.h
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 MAKING_DEPENDENCIES
+#ifndef _J_f_flags
+#define _J_f_flags
+#include "flags.h"
+#endif
+#endif
diff --git a/gcc/f/g77.1 b/gcc/f/g77.1
new file mode 100644
index 00000000000..fe8b897266f
--- /dev/null
+++ b/gcc/f/g77.1
@@ -0,0 +1,364 @@
+.\" Copyright (c) 1995, 1996 Free Software Foundation              -*-Text-*-
+.\" See section COPYING for conditions for redistribution
+.\" FIXME: no info here on predefines.  Should there be?  extra for F77...
+.TH G77 1 "1997-06-20" "GNU Tools" "GNU Tools"
+.de BP
+.sp
+.ti \-.2i
+\(**
+..
+.SH NAME
+g77 \- GNU project F77 Compiler (v0.5.18)
+.SH SYNOPSIS
+.RB g77 " [" \c
+.IR option " | " "filename " ].\|.\|.
+.SH WARNING
+The information in this man page is an extract from the full
+documentation of the GNU Fortran compiler (version 0.5.18),
+and is limited to the meaning of the options.
+.PP
+This man page is not up to date, since no volunteers want to
+maintain it.  If you find a discrepancy between the man page and the
+software, please check the Info file, which is the authoritative
+documentation.
+.PP
+The version of GNU Fortran documented by the Info file is 0.5.21,
+which includes substantial improvements and changes since 0.5.18,
+the version documented in this man page.
+.PP
+If we find that the things in this man page that are out of date cause
+significant confusion or complaints, we will stop distributing the man
+page.  The alternative, updating the man page when we update the Info
+file, is impractical because the rest of the work of maintaining GNU Fortran
+leaves us no time for that.  The GNU project regards man pages as
+obsolete and should not let them take time away from other things.
+.PP
+For complete and current documentation, refer to the Info file `\|\c
+.B g77\c
+\&\|' or the manual
+.I
+Using and Porting GNU Fortran (for version 0.5.18)\c
+\&.  Both are made from the Texinfo source file
+.BR g77.texi .
+.PP
+If your system has the `\|\c
+.B info\c
+\&\|' command installed, the command `\|\c
+.B info g77\c
+\&\|' should work, unless
+.B g77
+has not been properly installed.
+If your system lacks `\|\c
+.B info\c
+\&\|', or you wish to avoid using it for now,
+the command `\|\c
+.B more /usr/info/g77.info*\c
+\&\|' should work, unless
+.B g77
+has not been properly installed.
+.PP
+If
+.B g77
+has not been properly installed, so that you
+cannot easily access the Info file for it,
+ask your system administrator, or the installer
+of
+.B g77
+(if you know who that is) to fix the problem.
+.SH DESCRIPTION
+The C and F77 compilers are integrated;
+.B g77
+is a program to call
+.B gcc with options to recognize F77.
+.B gcc
+processes input files
+through one or more of four stages: preprocessing, compilation,
+assembly, and linking.  This man page contains full descriptions for
+.I only
+F77 specific aspects of the compiler, though it also contains
+summaries of some general-purpose options.  For a fuller explanation
+of the compiler, see
+.BR gcc ( 1 ).
+
+For complete documentation on GNU Fortran, type
+.BR info g77
+
+F77 source files use the suffix `\|\c
+.B .f\c
+\&\|'; F77 files to be preprocessed by
+.BR cpp ( 1 )
+use the suffix `\|\c
+.B .F\c
+\&\|'.
+.SH OPTIONS
+There are many command-line options, including options to control
+details of optimization, warnings, and code generation, which are
+common to both
+.B gcc
+and
+.B g77\c
+\&.  For full information on all options, see
+.BR gcc ( 1 ).
+
+Options must be separate: `\|\c
+.B \-dr\c
+\&\|' is quite different from `\|\c
+.B \-d \-r
+\&\|'.
+
+Most `\|\c
+.B \-f\c
+\&\|' and `\|\c
+.B \-W\c
+\&\|' options have two contrary forms:
+.BI \-f name
+and
+.BI \-fno\- name\c
+\& (or
+.BI \-W name
+and
+.BI \-Wno\- name\c
+\&). Only the non-default forms are shown here.
+
+.TP
+.B \-c
+Compile or assemble the source files, but do not link.  The compiler
+output is an object file corresponding to each source file.
+.TP
+.BI \-D macro
+Define macro \c
+.I macro\c
+\& with the string `\|\c
+.B 1\c
+\&\|' as its definition.
+.TP
+.BI \-D macro = defn
+Define macro \c
+.I macro\c
+\& as \c
+.I defn\c
+\&.
+.TP
+.BI \-\-driver= command
+Specifies that 
+.IR command ,
+rather than 
+.RB ` gcc ',
+is to be invoked by 
+.RB ` g77 '
+to do its job.  Example: Within the gcc build directory after building
+GNU Fortran (but without having to install it),
+.nf
+  ./g77 \-\-driver=./xgcc -B./ foo.f
+.fi
+.TP
+.B \-E
+Stop after the preprocessing stage; do not run the compiler proper.  The
+output is preprocessed source code, which is sent to the
+standard output.
+.TP
+.B \-g
+Produce debugging information in the operating system's native format
+(for DBX or SDB or DWARF).  GDB also can work with this debugging
+information.  On most systems that use DBX format, `\|\c
+.B \-g\c
+\&\|' enables use
+of extra debugging information that only GDB can use.
+
+Unlike most other Fortran compilers, GNU Fortran allows you to use `\|\c
+.B \-g\c
+\&\|' with
+`\|\c
+.B \-O\c
+\&\|'.  The shortcuts taken by optimized code may occasionally
+produce surprising results: some variables you declared may not exist
+at all; flow of control may briefly move where you did not expect it;
+some statements may not be executed because they compute constant
+results or their values were already at hand; some statements may
+execute in different places because they were moved out of loops.
+
+Nevertheless it proves possible to debug optimized output.  This makes
+it reasonable to use the optimizer for programs that might have bugs.
+.TP
+.BI "\-I" "dir"\c
+\&
+Append directory \c
+.I dir\c
+\& to the list of directories searched for include files.
+.TP
+.BI "\-L" "dir"\c
+\&
+Add directory \c
+.I dir\c
+\& to the list of directories to be searched
+for `\|\c
+.B \-l\c
+\&\|'.
+.TP
+.BI \-l library\c
+\&
+Use the library named \c
+.I library\c
+\& when linking.
+.TP
+.B \-nostdinc
+Do not search the standard system directories for header files.  Only
+the directories you have specified with
+.B \-I
+options (and the current directory, if appropriate) are searched.
+.TP
+.B \-O
+Optimize.  Optimizing compilation takes somewhat more time, and a lot
+more memory for a large function.  See the GCC documentation for
+further optimisation options.  Loop unrolling, in particular, may be
+worth investigating for typical numerical Fortran programs.
+.TP
+.BI "\-o " file\c
+\&
+Place output in file \c
+.I file\c
+\&.
+.TP
+.B \-S
+Stop after the stage of compilation proper; do not assemble.  The output
+is an assembler code file for each non-assembler input
+file specified.
+.TP
+.BI \-U macro
+Undefine macro \c
+.I macro\c
+\&.
+.TP
+.B \-v
+Print (on standard error output) the commands executed to run the
+stages of compilation.  Also print the version number of the compiler
+driver program and of the preprocessor and the compiler proper.  The
+version numbers of g77 itself and the GCC distribution on which it is
+based are distinct.  Use 
+.RB ` \-\-driver=true '
+to disable actual invocation of 
+.RB ` gcc '
+(since
+.RB ` true '
+is the name of a UNIX command that simply returns success status).
+The command
+.RB ` "gcc -v" '
+is the appropriate one to determine the g77 and GCC version numbers;
+it will produce an irrelevant error message from
+.RB ` ld '.
+.TP
+.B \-Wall
+Issue warnings for conditions which pertain to usage that we recommend
+avoiding and that we believe is easy to avoid, even in conjunction
+with macros.
+.PP
+
+.SH FILES
+.ta \w'LIBDIR/g77\-include 'u
+file.h    C header (preprocessor) file
+.br
+file.f    Fortran source file
+.br
+file.for  Fortran source file
+.br
+file.F    preprocessed Fortran source file
+.br
+file.fpp  preprocessed Fortran source file
+.br
+file.s    assembly language file
+.br
+file.o    object file
+.br
+a.out     link edited output
+.br
+\fITMPDIR\fR/cc\(**	temporary files
+.br
+\fILIBDIR\fR/cpp	preprocessor
+.br
+\fILIBDIR\fR/f771	compiler
+.br
+\fILIBDIR\fR/libf2c.a	Fortran run-time library
+.br
+\fILIBDIR\fR/libgcc.a	GCC subroutine library
+.br
+/lib/crt[01n].o	start-up routine
+.br
+/lib/libc.a	standard C library, see
+.IR intro (3)
+.br
+/usr/include	standard directory for
+.B #include
+files
+.br
+\fILIBDIR\fR/include	standard gcc directory for
+.B #include
+files
+.I LIBDIR
+is usually
+.B /usr/local/lib/\c
+.IR machine / version .
+.br
+.I TMPDIR
+comes from the environment variable
+.B TMPDIR
+(default
+.B /usr/tmp
+if available, else
+.B /tmp\c
+\&).
+.SH "SEE ALSO"
+gcc(1), cpp(1), as(1), ld(1), gdb(1), adb(1), dbx(1), sdb(1).
+.br
+.RB "`\|" g77 "\|', `\|" gcc "\|', `\|" cpp \|',
+.RB `\| as \|', `\| ld \|',
+and
+.RB `\| gdb \|'
+entries in
+.B info\c
+\&.
+.br
+.I
+Using and Porting GNU Fortran (for version 0.5.18)\c
+, James Craig Burley;
+.I
+Using and Porting GNU CC (for version 2.0)\c
+, Richard M. Stallman;
+.I
+The C Preprocessor\c
+, Richard M. Stallman;
+.I
+Debugging with GDB: the GNU Source-Level Debugger\c
+, Richard M. Stallman and Roland H. Pesch;
+.I
+Using as: the GNU Assembler\c
+, Dean Elsner, Jay Fenlason & friends;
+.I
+gld: the GNU linker\c
+, Steve Chamberlain and Roland Pesch.
+
+.SH BUGS
+For instructions on how to report bugs, see the file
+.B DOC
+in the g77 distribution.
+
+.SH COPYING
+Copyright (c) 1991, 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
+.PP
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+.PP
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+.PP
+Permission is granted to copy and distribute translations of this
+manual into another language, under the above conditions for modified
+versions, except that this permission notice may be included in
+translations approved by the Free Software Foundation instead of in
+the original English.
+.SH AUTHORS
+See the GNU CC Manual for the contributors to GNU CC.
+See the GNU Fortran Manual for the contributors to
+GNU Fortran.
diff --git a/gcc/f/g77.c b/gcc/f/g77.c
new file mode 100644
index 00000000000..0d6f07fae30
--- /dev/null
+++ b/gcc/f/g77.c
@@ -0,0 +1,1557 @@
+/* G77 preliminary semantic processing for the compiler driver.
+   Copyright (C) 1993-1997 Free Software Foundation, Inc.
+   Contributed by Brendan Kehoe (brendan@cygnus.com), with significant
+   modifications for GNU Fortran by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 program is a wrapper to the main `gcc' driver.  The generic
+   goal of this program 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.  Put `-xf77', `-xf77-cpp-input' or `-xratfor' before each list
+       of foo.f, foo.F or foo.r source files and put `-xnone' after
+       that list, if necessary.  This shouldn't normally be necessary,
+       but it is done in case gcc.c normally treats .f/.F files as,
+       say, to be compiled by f2c.
+
+   2.  Make sure `-lf2c -lm' is at the end of the list.
+
+   3.  Make sure each time `-lf2c' or `-lm' is seen, it forms
+       part of the series `-lf2c -lm'.
+
+   #1 is not done if `-xfoo' is in effect (where foo is not "none").
+   #2 and #3 are not done if `-nostdlib' or any option that disables
+   the linking phase is present, or if `-xfoo' is in effect.  Note that
+   -v by itself disables linking.
+
+   This program was originally made out of gcc/cp/g++.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.  */
+
+#ifndef LANGUAGE_F77
+#define LANGUAGE_F77 1	/* Assume f77 language wanted. */
+#endif
+
+#if LANGUAGE_F77 != 1
+#include <stdio.h>
+
+int
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  fprintf (stderr, "\
+g77: `f77' language not included in list of languages\n\
+     built with this installation of gcc.\n");
+  exit (1);
+}
+
+#else	/* LANGUAGE_F77 == 1 */
+#include "config.j"
+#include "zzz.h"
+#include <sys/types.h>
+#include <errno.h>
+
+#ifndef _WIN32
+#include <sys/file.h>   /* May get R_OK, etc. on some systems.  */
+#else
+#include <process.h>
+#endif
+
+#ifdef __STDC__
+#include <stdarg.h>
+#else
+#include <varargs.h>
+#endif
+#include <stdio.h>
+
+/* Include multi-lib information.  */
+#include "multilib.h"
+
+#ifndef R_OK
+#define R_OK 4
+#define W_OK 2
+#define X_OK 1
+#endif
+
+#ifndef WIFSIGNALED
+#define WIFSIGNALED(S) (((S) & 0xff) != 0 && ((S) & 0xff) != 0x7f)
+#endif
+#ifndef WTERMSIG
+#define WTERMSIG(S) ((S) & 0x7f)
+#endif
+#ifndef WIFEXITED
+#define WIFEXITED(S) (((S) & 0xff) == 0)
+#endif
+#ifndef WEXITSTATUS
+#define WEXITSTATUS(S) (((S) & 0xff00) >> 8)
+#endif
+
+/* Defined to the name of the compiler; if using a cross compiler, the
+   Makefile should compile this file with the proper name
+   (e.g., "i386-aout-gcc").  */
+#ifndef GCC_NAME
+#define GCC_NAME "gcc"
+#endif
+
+/* On MSDOS, write temp files in current dir
+   because there's no place else we can expect to use.  */
+#ifdef __MSDOS__
+#ifndef P_tmpdir
+#define P_tmpdir "."
+#endif
+#ifndef R_OK
+#define R_OK 4
+#define W_OK 2
+#define X_OK 1
+#endif
+#endif
+
+/* Add prototype support.  */
+#ifndef PROTO
+#if defined (USE_PROTOTYPES) ? USE_PROTOTYPES : defined (__STDC__)
+#define PROTO(ARGS) ARGS
+#else
+#define PROTO(ARGS) ()
+#endif
+#endif
+
+#ifndef VPROTO
+#ifdef __STDC__
+#define PVPROTO(ARGS)		ARGS
+#define VPROTO(ARGS)		ARGS
+#define VA_START(va_list,var)	va_start(va_list,var)
+#else
+#define PVPROTO(ARGS)		()
+#define VPROTO(ARGS)		(va_alist) va_dcl
+#define VA_START(va_list,var)	va_start(va_list)
+#endif
+#endif
+
+/* Define a generic NULL if one hasn't already been defined.  */
+
+#ifndef NULL
+#define NULL 0
+#endif
+
+/* Define O_RDONLY if the system hasn't defined it for us. */
+#ifndef O_RDONLY
+#define O_RDONLY 0
+#endif
+
+#ifndef GENERIC_PTR
+#if defined (USE_PROTOTYPES) ? USE_PROTOTYPES : defined (__STDC__)
+#define GENERIC_PTR void *
+#else
+#define GENERIC_PTR char *
+#endif
+#endif
+
+#ifndef NULL_PTR
+#define NULL_PTR ((GENERIC_PTR)0)
+#endif
+
+#ifdef USG
+#define vfork fork
+#endif /* USG */
+
+/* On MSDOS, write temp files in current dir
+   because there's no place else we can expect to use.  */
+#ifdef __MSDOS__
+#ifndef P_tmpdir
+#define P_tmpdir "."
+#endif
+#endif
+
+/* By default there is no special suffix for executables.  */
+#ifndef EXECUTABLE_SUFFIX
+#define EXECUTABLE_SUFFIX ""
+#endif
+
+/* By default, colon separates directories in a path.  */
+#ifndef PATH_SEPARATOR
+#define PATH_SEPARATOR ':'
+#endif
+
+#ifndef DIR_SEPARATOR
+#define DIR_SEPARATOR '/'
+#endif
+
+static char dir_separator_str[] = {DIR_SEPARATOR, 0};
+
+extern char *getenv ();
+
+#ifndef errno
+extern int errno;
+#endif
+
+extern int sys_nerr;
+#ifndef HAVE_STRERROR
+#if defined(bsd4_4)
+extern const char *const sys_errlist[];
+#else
+extern char *sys_errlist[];
+#endif
+#else
+extern char *strerror();
+#endif
+
+/* Name with which this program was invoked.  */
+static char *programname;
+
+/* argc, argv from main().  */
+static int xargc;
+static char **xargv;
+
+/* The new argument list will be contained in these, though if identical
+   to the original list, these will be == xargc, xargv.  */
+static int newargc;
+static char **newargv;
+
+/* 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_for_linker,		/* Aka `-Xlinker' and `-Wl,'. */
+  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_P,			/* Aka --print-*-name. */
+  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 FOLLOWING COMES STRAIGHT FROM prerelease gcc-2.8.0/gcc.c:  */
+
+/* This defines which switch letters take arguments.  */
+
+#define DEFAULT_SWITCH_TAKES_ARG(CHAR)      \
+  ((CHAR) == 'D' || (CHAR) == 'U' || (CHAR) == 'o' \
+   || (CHAR) == 'e' || (CHAR) == 'T' || (CHAR) == 'u' \
+   || (CHAR) == 'I' || (CHAR) == 'm' || (CHAR) == 'x' \
+   || (CHAR) == 'L' || (CHAR) == 'A')
+
+#ifndef SWITCH_TAKES_ARG
+#define SWITCH_TAKES_ARG(CHAR) DEFAULT_SWITCH_TAKES_ARG(CHAR)
+#endif
+
+/* This defines which multi-letter switches take arguments.  */
+
+#define DEFAULT_WORD_SWITCH_TAKES_ARG(STR)		\
+ (!strcmp (STR, "Tdata") || !strcmp (STR, "Ttext")	\
+  || !strcmp (STR, "Tbss") || !strcmp (STR, "include")	\
+  || !strcmp (STR, "imacros") || !strcmp (STR, "aux-info") \
+  || !strcmp (STR, "idirafter") || !strcmp (STR, "iprefix") \
+  || !strcmp (STR, "iwithprefix") || !strcmp (STR, "iwithprefixbefore") \
+  || !strcmp (STR, "isystem"))
+
+#ifndef WORD_SWITCH_TAKES_ARG
+#define WORD_SWITCH_TAKES_ARG(STR) DEFAULT_WORD_SWITCH_TAKES_ARG (STR)
+#endif
+
+/* This is the common prefix we use to make temp file names.
+   It is chosen once for each run of this program.
+   It is substituted into a spec by %g.
+   Thus, all temp file names contain this prefix.
+   In practice, all temp file names start with this prefix.
+
+   This prefix comes from the envvar TMPDIR if it is defined;
+   otherwise, from the P_tmpdir macro if that is defined;
+   otherwise, in /usr/tmp or /tmp.  */
+
+static char *temp_filename;
+static char *temp_filename_f;	/* Same with ".f" appended. */
+
+/* Length of the prefix.  */
+
+static int temp_filename_length;
+
+/* The number of errors that have occurred; the link phase will not be
+   run if this is non-zero.  */
+static int error_count = 0;
+
+/* Number of commands that exited with a signal.  */
+
+static int signal_count = 0;
+
+/* END OF STUFF FROM gcc-2.7.0/gcc.c.  */
+
+char *
+my_strerror(e)
+     int e;
+{
+
+#ifdef HAVE_STRERROR
+  return strerror(e);
+
+#else
+
+  static char buffer[30];
+  if (!e)
+    return "";
+
+  if (e > 0 && e < sys_nerr)
+    return sys_errlist[e];
+
+  sprintf (buffer, "Unknown error %d", e);
+  return buffer;
+#endif
+}
+
+#ifdef HAVE_VPRINTF
+/* Output an error message and exit */
+
+static void
+fatal VPROTO((char *format, ...))
+{
+#ifndef __STDC__
+  char *format;
+#endif
+  va_list ap;
+
+  VA_START (ap, format);
+
+#ifndef __STDC__
+  format = va_arg (ap, char*);
+#endif
+
+  fprintf (stderr, "%s: ", programname);
+  vfprintf (stderr, format, ap);
+  va_end (ap);
+  fprintf (stderr, "\n");
+#if 0
+  /* XXX Not needed for g77 driver.  */
+  delete_temp_files ();
+#endif
+  exit (1);
+}
+
+static void
+error VPROTO((char *format, ...))
+{
+#ifndef __STDC__
+  char *format;
+#endif
+  va_list ap;
+
+  VA_START (ap, format);
+
+#ifndef __STDC__
+  format = va_arg (ap, char*);
+#endif
+
+  fprintf (stderr, "%s: ", programname);
+  vfprintf (stderr, format, ap);
+  va_end (ap);
+
+  fprintf (stderr, "\n");
+}
+
+#else /* not HAVE_VPRINTF */
+
+static void
+error (msg, arg1, arg2)
+     char *msg, *arg1, *arg2;
+{
+  fprintf (stderr, "%s: ", programname);
+  fprintf (stderr, msg, arg1, arg2);
+  fprintf (stderr, "\n");
+}
+
+static void
+fatal (msg, arg1, arg2)
+     char *msg, *arg1, *arg2;
+{
+  error (msg, arg1, arg2);
+#if 0
+  /* XXX Not needed for g77 driver.  */
+  delete_temp_files ();
+#endif
+  exit (1);
+}
+
+#endif /* not HAVE_VPRINTF */
+
+/* More 'friendly' abort that prints the line and file.
+   config.h can #define abort fancy_abort if you like that sort of thing.  */
+
+void
+fancy_abort ()
+{
+  fatal ("Internal g77 abort.");
+}
+
+char *
+xmalloc (size)
+     unsigned size;
+{
+  register char *value = (char *) malloc (size);
+  if (value == 0)
+    fatal ("virtual memory exhausted");
+  return value;
+}
+
+static char *
+concat (s1, s2)
+     char *s1, *s2;
+{
+  int len1 = strlen (s1);
+  int len2 = strlen (s2);
+  char *result = xmalloc (len1 + len2 + 1);
+
+  strcpy (result, s1);
+  strcpy (result + len1, s2);
+  *(result + len1 + len2) = 0;
+
+  return result;
+}
+
+static char *
+concat3 (s1, s2, s3)
+     char *s1, *s2, *s3;
+{
+  return concat (concat (s1, s2), s3);
+}
+
+static char *
+concat4 (s1, s2, s3, s4)
+     char *s1, *s2, *s3, *s4;
+{
+  return concat (concat (s1, s2), concat (s3, s4));
+}
+
+static char *
+concat6 (s1, s2, s3, s4, s5, s6)
+     char *s1, *s2, *s3, *s4, *s5, *s6;
+{
+  return concat3 (concat (s1, s2), concat (s3, s4), concat (s5, s6));
+}
+
+static void
+pfatal_with_name (name)
+     char *name;
+{
+  char *s;
+
+  if (errno < sys_nerr)
+    s = concat ("%s: ", my_strerror (errno));
+  else
+    s = "cannot open `%s'";
+  fatal (s, name);
+}
+
+static void
+perror_exec (name)
+     char *name;
+{
+  char *s;
+
+  if (errno < sys_nerr)
+    s = concat ("installation problem, cannot exec `%s': ",
+		my_strerror (errno));
+  else
+    s = "installation problem, cannot exec `%s'";
+  error (s, name);
+}
+
+/* Compute a string to use as the base of all temporary file names.
+   It is substituted for %g.  */
+
+static char *
+choose_temp_base_try (try, base)
+     char *try;
+     char *base;
+{
+  char *rv;
+  if (base)
+    rv = base;
+  else if (try == (char *)0)
+    rv = 0;
+  else if (access (try, R_OK | W_OK) != 0)
+    rv = 0;
+  else
+    rv = try;
+  return rv;
+}
+
+static void
+choose_temp_base ()
+{
+  char *base = 0;
+  int len;
+
+  base = choose_temp_base_try (getenv ("TMPDIR"), base);
+  base = choose_temp_base_try (getenv ("TMP"), base);
+  base = choose_temp_base_try (getenv ("TEMP"), base);
+
+#ifdef P_tmpdir
+  base = choose_temp_base_try (P_tmpdir, base);
+#endif
+
+  base = choose_temp_base_try (concat4 (dir_separator_str, "usr", 
+                                        dir_separator_str, "tmp"), 
+                                base);
+  base = choose_temp_base_try (concat (dir_separator_str, "tmp"), base);
+ 
+  /* If all else fails, use the current directory! */
+  if (base == (char *)0)
+    base = concat (".", dir_separator_str);
+
+  len = strlen (base);
+  temp_filename = xmalloc (len + strlen (concat (dir_separator_str, 
+                                                 "gfXXXXXX")) + 1);
+  strcpy (temp_filename, base);
+  if (len > 0 && temp_filename[len-1] != '/'
+      && temp_filename[len-1] != DIR_SEPARATOR)
+    temp_filename[len++] = DIR_SEPARATOR;
+  strcpy (temp_filename + len, "gfXXXXXX");
+
+  mktemp (temp_filename);
+  temp_filename_length = strlen (temp_filename);
+  if (temp_filename_length == 0)
+    abort ();
+
+  temp_filename_f = xmalloc (temp_filename_length + 2);
+  strcpy (temp_filename_f, temp_filename);
+  temp_filename_f[temp_filename_length] = '.';
+  temp_filename_f[temp_filename_length + 1] = 'f';
+  temp_filename_f[temp_filename_length + 2] = '\0';
+}
+
+/* This structure describes one mapping.  */
+struct option_map
+{
+  /* The long option's name.  */
+  char *name;
+  /* The equivalent short option.  */
+  char *equivalent;
+  /* Argument info.  A string of flag chars; NULL equals no options.
+     a => argument required.
+     o => argument optional.
+     j => join argument to equivalent, making one word.
+     * => require other text after NAME as an argument.  */
+  char *arg_info;
+};
+
+/* This is the table of mappings.  Mappings are tried sequentially
+   for each option encountered; the first one that matches, wins.  */
+
+struct option_map option_map[] =
+ {
+   {"--all-warnings", "-Wall", 0},
+   {"--ansi", "-ansi", 0},
+   {"--assemble", "-S", 0},
+   {"--assert", "-A", "a"},
+   {"--comments", "-C", 0},
+   {"--compile", "-c", 0},
+   {"--debug", "-g", "oj"},
+   {"--define-macro", "-D", "a"},
+   {"--dependencies", "-M", 0},
+   {"--driver", "", 0},		/* Wrapper-specific. */
+   {"--dump", "-d", "a"},
+   {"--dumpbase", "-dumpbase", "a"},
+   {"--entry", "-e", 0},
+   {"--extra-warnings", "-W", 0},
+   {"--for-assembler", "-Wa", "a"},
+   {"--for-linker", "-Xlinker", "a"},
+   {"--force-link", "-u", "a"},
+   {"--imacros", "-imacros", "a"},
+   {"--include", "-include", "a"},
+   {"--include-barrier", "-I-", 0},
+   {"--include-directory", "-I", "a"},
+   {"--include-directory-after", "-idirafter", "a"},
+   {"--include-prefix", "-iprefix", "a"},
+   {"--include-with-prefix", "-iwithprefix", "a"},
+   {"--include-with-prefix-before", "-iwithprefixbefore", "a"},
+   {"--include-with-prefix-after", "-iwithprefix", "a"},
+   {"--language", "-x", "a"},
+   {"--library-directory", "-L", "a"},
+   {"--machine", "-m", "aj"},
+   {"--machine-", "-m", "*j"},
+   {"--no-line-commands", "-P", 0},
+   {"--no-precompiled-includes", "-noprecomp", 0},
+   {"--no-standard-includes", "-nostdinc", 0},
+   {"--no-standard-libraries", "-nostdlib", 0},
+   {"--no-warnings", "-w", 0},
+   {"--optimize", "-O", "oj"},
+   {"--output", "-o", "a"},
+   {"--pedantic", "-pedantic", 0},
+   {"--pedantic-errors", "-pedantic-errors", 0},
+   {"--pipe", "-pipe", 0},
+   {"--prefix", "-B", "a"},
+   {"--preprocess", "-E", 0},
+   {"--print-file-name", "-print-file-name=", "aj"},
+   {"--print-libgcc-file-name", "-print-libgcc-file-name", 0},
+   {"--print-missing-file-dependencies", "-MG", 0},
+   {"--print-multi-lib", "-print-multi-lib", 0},
+   {"--print-multi-directory", "-print-multi-directory", 0},
+   {"--print-prog-name", "-print-prog-name=", "aj"},
+   {"--profile", "-p", 0},
+   {"--profile-blocks", "-a", 0},
+   {"--quiet", "-q", 0},
+   {"--save-temps", "-save-temps", 0},
+   {"--shared", "-shared", 0},
+   {"--silent", "-q", 0},
+   {"--static", "-static", 0},
+   {"--symbolic", "-symbolic", 0},
+   {"--target", "-b", "a"},
+   {"--trace-includes", "-H", 0},
+   {"--traditional", "-traditional", 0},
+   {"--traditional-cpp", "-traditional-cpp", 0},
+   {"--trigraphs", "-trigraphs", 0},
+   {"--undefine-macro", "-U", "a"},
+   {"--use-version", "-V", "a"},
+   {"--user-dependencies", "-MM", 0},
+   {"--verbose", "-v", 0},
+   {"--version", "-dumpversion", 0},
+   {"--warn-", "-W", "*j"},
+   {"--write-dependencies", "-MD", 0},
+   {"--write-user-dependencies", "-MMD", 0},
+   {"--", "-f", "*j"}
+ };
+
+/* Compares --options that take one arg.  */
+
+static int
+opteq (xskip, xarg, opt, name)
+     int *xskip;
+     char **xarg;
+     char *opt;
+     char *name;
+{
+  int optlen;
+  int namelen;
+  int complen;
+  int i;
+  int cmp = strcmp (opt, name);
+  int skip = 1;
+  char *arg = NULL;
+
+  if (cmp == 0)
+    {
+      /* Easy, a straight match.  */
+      *xskip = skip;
+      *xarg = arg;
+      return cmp;
+    }
+
+  optlen = strlen (opt);
+
+  for (i = 0; i < sizeof (option_map) / sizeof (option_map[0]); ++i)
+    {
+      char *arginfo;
+      int j;
+
+      arginfo = option_map[i].arg_info;
+      if (arginfo == NULL)
+	arginfo = "";
+
+      namelen = strlen (option_map[i].name);
+      complen = optlen > namelen ? namelen : optlen;
+
+      if (strncmp (opt, option_map[i].name, complen) == 0)
+	{
+	  if (optlen < namelen)
+	    {
+	      for (j = i + 1;
+		   j < sizeof (option_map) / sizeof (option_map[0]);
+		   ++j)
+		if ((strlen (option_map[j].name) >= optlen)
+		    && (strncmp (opt, option_map[j].name, optlen) == 0))
+		  fatal ("Ambiguous abbreviation `%s'", opt);
+	    }
+
+	  if (optlen > namelen)
+	    {
+	      if (opt[namelen] == '=')
+		{
+		  skip = 0;
+		  arg = opt + namelen + 1;
+		}
+	      else if (index (arginfo, '*') != 0)
+		;
+	      else
+		continue;
+	    }
+	  else if (index (arginfo, '*') != 0)
+	    fatal ("Incomplete `%s' option", option_map[i].name);
+
+	  if (strcmp (name, option_map[i].name) != 0)
+	    return 1;		/* Not what is being looked for. */
+
+	  *xskip = skip;
+	  *xarg = arg;
+	  return 0;
+	}
+    }
+
+  return 1;
+}
+
+/* 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).  */
+
+static void
+lookup_option (xopt, xskip, xarg, text)
+     Option *xopt;
+     int *xskip;
+     char **xarg;
+     char *text;
+{
+  Option opt = OPTION_;
+  int skip;
+  char *arg = NULL;
+
+  if ((skip = SWITCH_TAKES_ARG (text[1])) > (text[2] != '\0'))
+    skip -= (text[2] != '\0');	/* Usually one of "DUoeTuImLA". */
+
+  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, skip = (text[2] == '\0'), 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] == 'W') && (text[2] == 'l') && (text[3] == ','))
+    opt = OPTION_for_linker, skip = 0;
+  else if (text[1] == 'x')
+    opt = OPTION_x, skip = (text[2] == '\0'), arg = text + 2;
+  else
+    {
+      if ((skip = WORD_SWITCH_TAKES_ARG (text + 1)) != 0)
+	/* Usually one of "Tdata", "Ttext", "Tbss", "include",
+	   "imacros", "aux-info", "idirafter", "iprefix",
+	   "iwithprefix", "iwithprefixbefore", "isystem".  */
+	;
+
+      if (strcmp (text, "--assemble") == 0)
+	opt = OPTION_S;
+      else if (strcmp (text, "--compile") == 0)
+	opt = OPTION_c;
+      else if (opteq (&skip, &arg, text, "--driver") == 0)
+	opt = OPTION_driver;
+      else if (strcmp (text, "--help") == 0)
+	opt = OPTION_help;
+      else if ((opteq (&skip, &arg, text, "--imacros") == 0)
+	       || (opteq (&skip, &arg, text, "--include") == 0)
+	       || (opteq (&skip, &arg, text, "--include-directory-after") == 0)
+	       || (opteq (&skip, &arg, text, "--include-prefix") == 0)
+	       || (opteq (&skip, &arg, text, "--include-with-prefix") == 0)
+	       || (opteq (&skip, &arg, text, "--include-with-prefix-before") == 0)
+	       || (opteq (&skip, &arg, text, "--include-with-prefix-after") == 0))
+	opt = OPTION_i;
+      else if (opteq (&skip, &arg, text, "--language") == 0)
+	opt = OPTION_x;
+      else if (opteq (&skip, &arg, text, "--library-directory") == 0)
+	opt = OPTION_L;
+      else if ((strcmp (text, "-M") == 0)
+	       || (strcmp (text, "--dependencies") == 0))
+	opt = OPTION_M;
+      else if ((strcmp (text, "-MM") == 0)
+	       || (strcmp (text, "--user-dependencies") == 0))
+	opt = OPTION_MM;
+      else if (strcmp (text, "--output") == 0)
+	opt = OPTION_o;
+      else if (opteq (&skip, &arg, text, "--prefix") == 0)
+	opt = OPTION_B;
+      else if (strcmp (text, "--preprocess") == 0)
+	opt = OPTION_E;
+      else if ((opteq (&skip, &arg, text, "--print-file-name") == 0)
+	       || (strcmp (text, "--print-libgcc-file-name") == 0)
+	       || (strcmp (text, "--print-multi-lib") == 0)
+	       || (strcmp (text, "--print-multi-directory") == 0)
+	       || (opteq (&skip, &arg, text, "--print-prog-name") == 0))
+	opt = OPTION_P;
+      else if ((strcmp (text, "-nostdlib") == 0)
+	       || (strcmp (text, "--no-standard-libraries") == 0)
+	       || (strcmp (text, "-nodefaultlibs") == 0))
+	opt = OPTION_nostdlib;
+      else if (strcmp (text, "-fsyntax-only") == 0)
+	opt = OPTION_syntax_only;
+      else if (opteq (&skip, &arg, text, "--use-version") == 0)
+	opt = OPTION_V;
+      else if (strcmp (text, "--verbose") == 0)
+	opt = OPTION_v;
+      else if (strcmp (text, "--version") == 0)
+	opt = OPTION_version;
+      else if (strcmp (text, "-Xlinker") == 0)
+	skip = 1;
+      else if ((opteq (&skip, &arg, text, "--assert") == 0)
+	       || (opteq (&skip, &arg, text, "--define-macro") == 0)
+	       || (opteq (&skip, &arg, text, "--dump") == 0)
+	       || (opteq (&skip, &arg, text, "--dumpbase") == 0)
+	       || (opteq (&skip, &arg, text, "--for-assembler") == 0)
+	       || (opteq (&skip, &arg, text, "--for-linker") == 0)
+	       || (opteq (&skip, &arg, text, "--force-link") == 0)
+	       || (opteq (&skip, &arg, text, "--machine") == 0)
+	       || (opteq (&skip, &arg, text, "--target") == 0)
+	       || (opteq (&skip, &arg, text, "--undefine-macro") == 0))
+	;
+      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;
+    }
+}
+
+static void
+append_arg (arg)
+    char *arg;
+{
+  static int newargsize;
+
+#if 0
+  fprintf (stderr, "`%s'\n", arg);
+#endif
+
+  if ((newargv == xargv)
+      && (arg == xargv[newargc]))
+    {
+      ++newargc;
+      return;			/* Nothing new here. */
+    }
+
+  if (newargv == xargv)
+    {				/* Make new arglist. */
+      int i;
+
+      newargsize = (xargc << 2) + 20;
+      newargv = (char **) malloc (newargsize * sizeof (char *));
+
+      /* Copy what has been done so far.  */
+      for (i = 0; i < newargc; ++i)
+	newargv[i] = xargv[i];
+    }
+
+  if (newargc == newargsize)
+    fatal ("overflowed output arg list for `%s'", arg);
+  newargv[newargc++] = arg;
+}
+
+extern int execv (), execvp ();
+
+/* If a stage of compilation returns an exit status >= 1,
+   compilation of that file ceases.  */
+
+#define MIN_FATAL_STATUS 1
+
+/* stdin file number.  */
+#define STDIN_FILE_NO 0
+
+/* stdout file number.  */
+#define STDOUT_FILE_NO 1
+
+/* value of `pipe': port index for reading.  */
+#define READ_PORT 0
+
+/* value of `pipe': port index for writing.  */
+#define WRITE_PORT 1
+
+/* Pipe waiting from last process, to be used as input for the next one.
+   Value is STDIN_FILE_NO if no pipe is waiting
+   (i.e. the next command is the first of a group).  */
+
+static int last_pipe_input;
+
+/* Fork one piped subcommand.  FUNC is the system call to use
+   (either execv or execvp).  ARGV is the arg vector to use.
+   NOT_LAST is nonzero if this is not the last subcommand
+   (i.e. its output should be piped to the next one.)  */
+
+#ifdef __MSDOS__
+
+#include <process.h>
+static int
+pexecute (search_flag, program, argv, not_last)
+     int search_flag;
+     char *program;
+     char *argv[];
+     int not_last;
+{
+#ifdef __GO32__
+  int i = (search_flag ? spawnv : spawnvp) (1, program, argv);
+#else
+  char *scmd, *rf;
+  FILE *argfile;
+  int i, el = search_flag ? 0 : 4;
+
+  scmd = (char *)malloc (strlen (program) + strlen (temp_filename) + 6 + el);
+  rf = scmd + strlen(program) + 2 + el;
+  sprintf (scmd, "%s%s @%s.gp", program,
+	   (search_flag ? "" : ".exe"), temp_filename);
+  argfile = fopen (rf, "w");
+  if (argfile == 0)
+    pfatal_with_name (rf);
+
+  for (i=1; argv[i]; i++)
+    {
+      char *cp;
+      for (cp = argv[i]; *cp; cp++)
+	{
+	  if (*cp == '"' || *cp == '\'' || *cp == '\\' || isspace (*cp))
+	    fputc ('\\', argfile);
+	  fputc (*cp, argfile);
+	}
+      fputc ('\n', argfile);
+    }
+  fclose (argfile);
+
+  i = system (scmd);
+
+  remove (rf);
+#endif
+  
+  if (i == -1)
+    {
+      perror_exec (program);
+      return MIN_FATAL_STATUS << 8;
+    }
+  return i << 8;
+}
+
+#endif
+
+#if !defined(__MSDOS__) && !defined(OS2) && !defined(_WIN32)
+
+static int
+pexecute (search_flag, program, argv, not_last)
+     int search_flag;
+     char *program;
+     char *argv[];
+     int not_last;
+{
+  int (*func)() = (search_flag ? execv : execvp);
+  int pid;
+  int pdes[2];
+  int input_desc = last_pipe_input;
+  int output_desc = STDOUT_FILE_NO;
+  int retries, sleep_interval;
+
+  /* If this isn't the last process, make a pipe for its output,
+     and record it as waiting to be the input to the next process.  */
+
+  if (not_last)
+    {
+      if (pipe (pdes) < 0)
+	pfatal_with_name ("pipe");
+      output_desc = pdes[WRITE_PORT];
+      last_pipe_input = pdes[READ_PORT];
+    }
+  else
+    last_pipe_input = STDIN_FILE_NO;
+
+  /* Fork a subprocess; wait and retry if it fails.  */
+  sleep_interval = 1;
+  for (retries = 0; retries < 4; retries++)
+    {
+      pid = vfork ();
+      if (pid >= 0)
+	break;
+      sleep (sleep_interval);
+      sleep_interval *= 2;
+    }
+
+  switch (pid)
+    {
+    case -1:
+#ifdef vfork
+      pfatal_with_name ("fork");
+#else
+      pfatal_with_name ("vfork");
+#endif
+      /* NOTREACHED */
+      return 0;
+
+    case 0: /* child */
+      /* Move the input and output pipes into place, if nec.  */
+      if (input_desc != STDIN_FILE_NO)
+	{
+	  close (STDIN_FILE_NO);
+	  dup (input_desc);
+	  close (input_desc);
+	}
+      if (output_desc != STDOUT_FILE_NO)
+	{
+	  close (STDOUT_FILE_NO);
+	  dup (output_desc);
+	  close (output_desc);
+	}
+
+      /* Close the parent's descs that aren't wanted here.  */
+      if (last_pipe_input != STDIN_FILE_NO)
+	close (last_pipe_input);
+
+      /* Exec the program.  */
+      (*func) (program, argv);
+      perror_exec (program);
+      exit (-1);
+      /* NOTREACHED */
+      return 0;
+
+    default:
+      /* In the parent, after forking.
+	 Close the descriptors that we made for this child.  */
+      if (input_desc != STDIN_FILE_NO)
+	close (input_desc);
+      if (output_desc != STDOUT_FILE_NO)
+	close (output_desc);
+
+      /* Return child's process number.  */
+      return pid;
+    }
+}
+
+#endif /* not __MSDOS__ and not OS2 and not _WIN32 */
+
+#if defined(OS2)
+
+static int
+pexecute (search_flag, program, argv, not_last)
+     int search_flag;
+     char *program;
+     char *argv[];
+     int not_last;
+{
+  return (search_flag ? spawnv : spawnvp) (1, program, argv);
+}
+#endif /* OS2 */
+
+#if defined(_WIN32)
+
+static int
+pexecute (search_flag, program, argv, not_last)
+     int search_flag;
+     char *program;
+     char *argv[];
+     int not_last;
+{
+  return (search_flag ? __spawnv : __spawnvp) (1, program, argv);
+}
+#endif /* _WIN32 */
+
+static int
+doit (char *program, char **argv)
+{
+  int pid;
+  int status;
+  int ret_code = 0;
+
+  pid = pexecute (0, program, argv, 0);
+
+#ifdef __MSDOS__
+  status = pid;
+#else
+#ifdef _WIN32
+  pid = cwait (&status, pid, WAIT_CHILD);
+#else
+  pid = wait (&status);
+#endif
+#endif
+  if (pid < 0)
+    abort ();
+
+  if (status != 0)
+    {
+      if (WIFSIGNALED (status))
+	{
+	  fatal ("Internal compiler error: program %s got fatal signal %d",
+		 program, WTERMSIG (status));
+	  signal_count++;
+	  ret_code = -1;
+	}
+      else if (WIFEXITED (status)
+	       && WEXITSTATUS (status) >= MIN_FATAL_STATUS)
+	ret_code = -1;
+    }
+
+  return ret_code;
+}
+
+int
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  register int i = 0;
+  register char *p;
+  int verbose = 0;
+  Option opt;
+  int skip;
+  char *arg;
+  int n_infiles = 0;
+  int n_outfiles = 0;
+
+  /* This will be NULL if we encounter a situation where we should not
+     link in libf2c.  */
+  char *library = "-lf2c";
+
+  /* This will become 0 if anything other than -v and kin (like -V)
+     is seen, meaning the user is trying to accomplish something.
+     If it remains nonzero, and the user wants version info, add stuff to
+     the command line to make gcc invoke all the appropriate phases
+     to get all the version info.  */
+  int add_version_magic = 1;
+
+  /* The name of the compiler we will want to run---by default, it
+     will be the definition of `GCC_NAME', e.g., `gcc'.  */
+  char *gcc = GCC_NAME;
+
+  /* 0 => -xnone in effect on input/output
+     1 => -xfoo in effect on input/output
+     2 => -xnone in effect on input, -xf77 on output
+     3 => -xnone in effect on input, -xf77-cpp-input on output.
+     4 => -xnone in effect on input, -xratfor on output.  */
+  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;
+
+  /* Initialize for append_arg().  */
+  xargc = argc;
+  newargv = xargv = argv;
+  newargc = 0;
+
+  append_arg (argv[0]);
+
+  p = argv[0] + strlen (argv[0]);
+  while (p != argv[0] && p[-1] != '/')
+    --p;
+  programname = p;
+
+  if (argc == 1)
+    fatal ("No input files specified.\n");
+
+#ifndef __MSDOS__
+  /* We do a little magic to find out where the main gcc executable
+     is.  If they ran us as /usr/local/bin/g77, then we will look
+     for /usr/local/bin/gcc; similarly, if they just ran us as `g77',
+     we'll just look for `gcc'.  */
+  if (p != argv[0])
+    {
+      *--p = '\0';
+      gcc = (char *) malloc ((strlen (argv[0]) + 1 + strlen (GCC_NAME) + 1)
+			     * sizeof (char));
+      sprintf (gcc, "%s/%s", argv[0], GCC_NAME);
+    }
+#endif
+
+  /* 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'))
+	{
+	  add_version_magic = 0;
+	  continue;
+	}
+      else if ((argv[i][0] != '-') || (argv[i][1] == 0))
+	{
+	  ++n_infiles;
+	  add_version_magic = 0;
+	  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 = NULL;
+	  add_version_magic = 0;
+	  break;
+
+	case OPTION_for_linker:
+	case OPTION_l:
+	  ++n_infiles;
+	  add_version_magic = 0;
+	  break;
+
+	case OPTION_o:
+	  ++n_outfiles;
+	  add_version_magic = 0;
+	  break;
+
+	case OPTION_v:
+	  if (!verbose)
+	    fprintf (stderr, "g77 version %s\n", ffezzz_version_string);
+	  verbose = 1;
+	  break;
+
+	case OPTION_b:
+	case OPTION_B:
+	case OPTION_L:
+	case OPTION_driver:
+	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 %s\n\
+Copyright (C) 1997 Free Software Foundation, Inc.\n\
+For more version information on components of the GNU Fortran\n\
+compilation system, especially useful when reporting bugs,\n\
+type the command `g77 --verbose'.\n\
+\n\
+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\
+", ffezzz_version_string);
+	  exit (0);
+	  break;
+
+	case OPTION_help:
+	  printf ("\
+Usage: g77 [OPTION]... FORTRAN-SOURCE...\n\
+\n\
+Compile and link Fortran source code to produce an executable program,\n\
+which by default is named `a.out', and can be invoked with the UNIX\n\
+command `./a.out'.\n\
+\n\
+Options:\n\
+--debug                include debugging information in executable.\n\
+--driver=COMMAND       specify preprocessor/compiler/linker driver\n\
+                         to use instead of the default `gcc'.\n\
+--help                 display this help and exit.\n\
+--optimize[=LEVEL]     take extra time and memory to make generated\n\
+                         executable run faster.  LEVEL is 0 for no\n\
+                         optimization, 1 for normal optimization, and\n\
+                         increases through 3 for more optimization.\n\
+--output=PROGRAM       name the executable PROGRAM instead of a.out;\n\
+                         invoke with the command `./PROGRAM'.\n\
+--version              display version information and exit.\n\
+\n\
+Many other options exist to tailor the compilation process, specify\n\
+the dialect of the Fortran source code, specify details of the\n\
+code-generation methodology, and so on.\n\
+\n\
+For more information on g77 and gcc, type the commands `info -f g77'\n\
+and `info -f gcc' to read the Info documentation on these commands.\n\
+\n\
+Report bugs to fortran@gnu.ai.mit.edu.\n");
+	  exit (0);
+	  break;
+
+	default:
+	  add_version_magic = 0;
+	  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\n", argv[i]);
+    }
+
+  if ((n_outfiles != 0) && (n_infiles == 0))
+    fatal ("No input files; unwilling to write output files");
+
+  /* Second pass through arglist, transforming arguments as appropriate.  */
+
+  for (i = 1; i < argc; ++i)
+    {
+      if (argv[i][0] == '\0')
+	append_arg (argv[i]);	/* Interesting.  Just append as is. */
+
+      else if ((argv[i][0] == '-') && (argv[i][1] != 'l'))
+	{
+	  /* Not a filename or library. */
+
+	  if (saw_library == 1)	/* -l<library>. */
+	    append_arg ("-lm");
+	  saw_library = 0;
+
+	  lookup_option (&opt, &skip, &arg, argv[i]);
+
+	  if (argv[i][1] == '\0')
+	    append_arg (argv[i]);	/* "-" == Standard input. */
+
+	  else if (opt == OPTION_x)
+	    {
+	      /* Track input language. */
+	      char *lang;
+
+	      if (arg == NULL)
+		lang = argv[i+1];
+	      else
+		lang = arg;
+
+	      saw_speclang = (strcmp (lang, "none") != 0);
+	    }
+	  else if (opt == OPTION_driver)
+	    {
+	      if (arg == NULL)
+		gcc = argv[i+1];
+	      else
+		gcc = arg;
+	      i += skip;
+	      continue;		/* Don't append args to new list. */
+	    }
+	  append_arg (argv[i]);
+	  for (; skip != 0; --skip)
+	    append_arg (argv[++i]);
+	}
+      else
+	{			/* A filename/library, not an option. */
+	  int len;
+	  int want_speclang;
+
+	  /* Here, always append the arg _after_ other stuff, possibly.  */
+
+	  if (saw_speclang == 1)
+	    saw_library = 0;	/* -xfoo currently active. */
+	  /* Put -xf77 and -xnone around list of filenames ending in
+	     .F or .f, but don't include other filenames or libraries
+	     in that list.  */
+	  else if ((argv[i][0] != '-')	/* Not a library. */
+		   && (len = strlen (argv[i])) > 2
+		   && ((argv[i][len - 1] == 'F')
+		       || (argv[i][len - 1] == 'f')
+		       || (argv[i][len - 1] == 'r'))
+		   && argv[i][len - 2] == '.')
+	    {			/* filename.f or filename.F. or filename.r */
+	      if (saw_library == 1)	/* -l<library>. */
+		append_arg ("-lm");
+	      saw_library = 0;
+	      switch (argv[i][len - 1])
+		{
+		case 'f':
+		  want_speclang = 2;
+		  break;
+		case 'F':
+		  want_speclang = 3;
+		  break;
+		case 'r':
+		  want_speclang = 4;
+		  break;
+		default:
+		  break;
+		}
+	      if (saw_speclang != want_speclang)
+		{
+		  switch (want_speclang)
+		    {
+		    case 2:
+		      append_arg ("-xf77");
+		      break;
+		    case 3:
+		      append_arg ("-xf77-cpp-input");
+		      break;
+		    case 4:
+		      append_arg ("-xratfor");
+		      break;
+		    default:
+		      break;
+		    }
+		  saw_speclang = want_speclang;
+		}
+	    }
+	  else
+	    {			/* -lfoo or "alien" filename. */
+	      if (saw_speclang)
+		append_arg ("-xnone");
+	      saw_speclang = 0;
+
+	      if (strcmp (argv[i], "-lm") == 0
+		  || strcmp (argv[i], "-lmath") == 0)
+		{
+		  if (saw_library == 1)
+		    saw_library = 2;	/* -l<library> -lm. */
+		  else if (library)
+		    {
+		      append_arg (library);
+		      saw_library = 2;	/* -l<library> -lm. */
+		    }
+		}
+	      else if ((library != NULL)
+		       && (strcmp (argv[i], library) == 0))
+		saw_library = 1;	/* -l<library>. */
+	      else
+		{		/* "Alien" library or filename. */
+		  if (saw_library == 1)
+		    append_arg ("-lm");
+		  saw_library = 0;
+		}
+	    }
+	  append_arg (argv[i]);
+	}
+    }
+
+  /* Add -lf2c -lm as necessary.  */
+
+  if (!add_version_magic && library)
+    {				/* Doing a link and no -nostdlib. */
+      if (saw_speclang)
+	append_arg ("-xnone");
+      switch (saw_library)
+	{
+	case 0:
+	  append_arg (library);
+	case 1:
+	  append_arg ("-lm");
+	default:
+	  break;
+	}
+    }
+  else if (add_version_magic && verbose)
+    {
+      FILE *fsrc;
+
+      choose_temp_base ();
+
+      append_arg ("-fnull-version");
+      append_arg ("-o");
+      append_arg (temp_filename);
+      append_arg ("-xf77-cpp-input");
+      append_arg (temp_filename_f);
+      append_arg ("-xnone");
+      if (library)
+	{
+	  append_arg (library);
+	  append_arg ("-lm");
+	}
+
+      fsrc = fopen (temp_filename_f, "w");
+      if (fsrc == 0)
+	pfatal_with_name (fsrc);
+      fputs ("      call g77__fvers;call g77__ivers;call g77__uvers;end\n", fsrc);
+      fclose (fsrc);
+    }
+
+  append_arg (NULL);
+  --newargc;			/* Don't count null arg at end. */
+
+  newargv[0] = gcc;		/* This is safe even if newargv == xargv. */
+
+  if (verbose)
+    {
+#if 0
+      if (newargv == xargv)
+	fprintf (stderr, "[Original:]");
+#endif
+
+      for (i = 0; i < newargc; i++)
+	fprintf (stderr, " %s", newargv[i]);
+      fprintf (stderr, "\n");
+    }
+
+  if (doit (gcc, newargv) < 0)
+    ++error_count;
+  else if (add_version_magic && verbose)
+    {
+      char *outargv[2];
+
+      outargv[0] = temp_filename;
+      outargv[1] = 0;
+
+      if (doit (temp_filename, outargv) < 0)
+	++error_count;
+
+      remove (temp_filename);
+      remove (temp_filename_f);
+    }
+
+  exit (error_count > 0 ? (signal_count ? 2 : 1) : 0);
+  /* NOTREACHED */
+  return 0;
+}
+
+#endif	/* LANGUAGE_F77 == 1 */
diff --git a/gcc/f/g77.texi b/gcc/f/g77.texi
new file mode 100644
index 00000000000..134deb56ceb
--- /dev/null
+++ b/gcc/f/g77.texi
@@ -0,0 +1,13831 @@
+\input texinfo  @c -*-texinfo-*-
+@c fix @set inside @example:
+@tex
+\gdef\set{\begingroup\catcode` =10 \parsearg\setxxx}
+\gdef\setyyy#1 #2\endsetyyy{%
+  \def\temp{#2}%
+  \ifx\temp\empty \global\expandafter\let\csname SET#1\endcsname = \empty
+  \else \setzzz{#1}#2\endsetzzz % Remove the trailing space \setxxx inserted.
+  \fi
+  \endgroup
+}
+@end tex
+
+@c %**start of header 
+@setfilename g77.info
+@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
+
+@c (For FSF printing, turn on smallbook; that is all that is needed.)
+
+@c smallbook
+
+@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
+@setchapternewpage odd
+
+@ifinfo
+This file explains how to use the GNU Fortran system.
+
+Published by the Free Software Foundation
+59 Temple Place - Suite 330
+Boston, MA 02111-1307 USA
+
+Copyright (C) 1995-1997 Free Software Foundation, Inc.
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+@ignore
+Permission is granted to process this file through Tex and print the
+results, provided the printed document carries copying permission
+notice identical to this one except for the removal of this paragraph
+(this paragraph not being relevant to the printed manual).
+
+@end ignore
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided also that the
+sections entitled ``GNU General Public License,'' ``Funding for Free
+Software,'' and ``Protect Your Freedom---Fight `Look And Feel'@w{}'' are
+included exactly as in the original, and provided that the entire
+resulting derived work is distributed under the terms of a permission
+notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that the sections entitled ``GNU General Public License,''
+``Funding for Free Software,'' and ``Protect Your Freedom---Fight `Look
+And Feel'@w{}'', and this permission notice, may be included in
+translations approved by the Free Software Foundation instead of in the
+original English.
+@end ifinfo
+
+Contributed by James Craig Burley (@email{burley@@gnu.ai.mit.edu}).
+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}).
+
+@finalout
+@titlepage
+@comment The title is printed in a large font.
+@center @titlefont{Using GNU Fortran}
+@sp 2
+@center James Craig Burley
+@sp 3
+@center Last updated 1997-08-11
+@sp 1
+@c The version number appears some more times in this file.
+
+@center for version 0.5.21
+@page
+@vskip 0pt plus 1filll
+Copyright @copyright{} 1995-1997 Free Software Foundation, Inc.
+@sp 2
+For GNU Fortran Version 0.5.21*
+@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
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided also that the
+sections entitled ``GNU General Public License,'' ``Funding for Free
+Software,'' and ``Protect Your Freedom---Fight `Look And Feel'@w{}'' are
+included exactly as in the original, and provided that the entire
+resulting derived work is distributed under the terms of a permission
+notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that the sections entitled ``GNU General Public License,''
+``Funding for Free Software,'' and ``Protect Your Freedom---Fight `Look
+And Feel'@w{}'', and this permission notice, may be included in
+translations approved by the Free Software Foundation instead of in the
+original English.
+@end titlepage
+@page
+
+@ifinfo
+
+@dircategory Fortran Programming
+@direntry
+* g77: (g77).               The GNU Fortran compilation system.
+@end direntry
+@node Top, Copying,, (DIR)
+@top Introduction
+@cindex Introduction
+
+@ifset INTERNALS
+@ifset USING
+This manual documents how to run, install and port the GNU Fortran
+compiler, as well as its new features and incompatibilities, and how to
+report bugs.  It corresponds to GNU Fortran version 0.5.21.
+@end ifset
+@end ifset
+
+@ifclear INTERNALS
+This manual documents how to run and install the GNU Fortran compiler,
+as well as its new features and incompatibilities, and how to report
+bugs.  It corresponds to GNU Fortran version 0.5.21.
+@end ifclear
+@ifclear USING
+This manual documents how to port the GNU Fortran compiler,
+as well as its new features and incompatibilities, and how to report
+bugs.  It corresponds to GNU Fortran version 0.5.21.
+@end ifclear
+
+@end ifinfo
+@menu
+* Copying::         GNU General Public License says
+                    how you can copy and share GNU Fortran.
+* 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.
+* Look and Feel::   Protect your freedom---fight ``look and feel''.
+@ifset USING
+* Getting Started:: Finding your way around this manual.
+* What is GNU Fortran?::  How @code{g77} fits into the universe.
+* G77 and GCC::     You can compile Fortran, C, or other programs.
+* Invoking G77::    Command options supported by @code{g77}.
+* News::            News about recent releases of @code{g77}.
+* Changes::         User-visible changes to recent releases of @code{g77}.
+* Language::        The GNU Fortran language.
+* Compiler::        The GNU Fortran compiler.
+* Other Dialects::  Dialects of Fortran supported by @code{g77}.
+* Other Compilers:: Fortran compilers other than @code{g77}.
+* Other Languages:: Languages other than Fortran.
+* Installation::    How to configure, compile and install GNU Fortran.
+* Debugging and Interfacing::  How @code{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 @code{g77} about new options.
+* Projects::        Projects for @code{g77} internals hackers.
+@end ifset
+
+* M: Diagnostics.   Diagnostics produced by @code{g77}.
+
+* Index::           Index of concepts and symbol names.
+@end menu
+@c yes, the "M: " @emph{is} intentional -- bad.def references it (CMPAMBIG)!
+
+@node Copying
+@unnumbered GNU GENERAL PUBLIC LICENSE
+@center Version 2, June 1991
+
+@display
+Copyright @copyright{} 1989, 1991 Free Software Foundation, Inc.
+59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
+
+Everyone is permitted to copy and distribute verbatim copies
+of this license document, but changing it is not allowed.
+@end display
+
+@unnumberedsec Preamble
+
+  The licenses for most software are designed to take away your
+freedom to share and change it.  By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software---to make sure the software is free for all its users.  This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it.  (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.)  You can apply it to
+your programs, too.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+  To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+  For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have.  You must make sure that they, too, receive or can get the
+source code.  And you must show them these terms so they know their
+rights.
+
+  We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+  Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software.  If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+  Finally, any free program is threatened constantly by software
+patents.  We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary.  To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.
+
+@iftex
+@unnumberedsec TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+@end iftex
+@ifinfo
+@center TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+@end ifinfo
+
+@enumerate 0
+@item
+This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License.  The ``Program'', below,
+refers to any such program or work, and a ``work based on the Program''
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language.  (Hereinafter, translation is included without limitation in
+the term ``modification''.)  Each licensee is addressed as ``you''.
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope.  The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+@item
+You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+@item
+You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+@enumerate a
+@item
+You must cause the modified files to carry prominent notices
+stating that you changed the files and the date of any change.
+
+@item
+You must cause any work that you distribute or publish, that in
+whole or in part contains or is derived from the Program or any
+part thereof, to be licensed as a whole at no charge to all third
+parties under the terms of this License.
+
+@item
+If the modified program normally reads commands interactively
+when run, you must cause it, when started running for such
+interactive use in the most ordinary way, to print or display an
+announcement including an appropriate copyright notice and a
+notice that there is no warranty (or else, saying that you provide
+a warranty) and that users may redistribute the program under
+these conditions, and telling the user how to view a copy of this
+License.  (Exception: if the Program itself is interactive but
+does not normally print such an announcement, your work based on
+the Program is not required to print an announcement.)
+@end enumerate
+
+These requirements apply to the modified work as a whole.  If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works.  But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+@item
+You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+@enumerate a
+@item
+Accompany it with the complete corresponding machine-readable
+source code, which must be distributed under the terms of Sections
+1 and 2 above on a medium customarily used for software interchange; or,
+
+@item
+Accompany it with a written offer, valid for at least three
+years, to give any third party, for a charge no more than your
+cost of physically performing source distribution, a complete
+machine-readable copy of the corresponding source code, to be
+distributed under the terms of Sections 1 and 2 above on a medium
+customarily used for software interchange; or,
+
+@item
+Accompany it with the information you received as to the offer
+to distribute corresponding source code.  (This alternative is
+allowed only for noncommercial distribution and only if you
+received the program in object code or executable form with such
+an offer, in accord with Subsection b above.)
+@end enumerate
+
+The source code for a work means the preferred form of the work for
+making modifications to it.  For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable.  However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+@item
+You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License.  Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+@item
+You are not required to accept this License, since you have not
+signed it.  However, nothing else grants you permission to modify or
+distribute the Program or its derivative works.  These actions are
+prohibited by law if you do not accept this License.  Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+@item
+Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions.  You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+@item
+If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all.  For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices.  Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+@item
+If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded.  In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+@item
+The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time.  Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number.  If the Program
+specifies a version number of this License which applies to it and ``any
+later version'', you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation.  If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+@item
+If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission.  For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this.  Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+@iftex
+@heading NO WARRANTY
+@end iftex
+@ifinfo
+@center NO WARRANTY
+@end ifinfo
+
+@item
+BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM ``AS IS'' WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+@item
+IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+@end enumerate
+
+@iftex
+@heading END OF TERMS AND CONDITIONS
+@end iftex
+@ifinfo
+@center END OF TERMS AND CONDITIONS
+@end ifinfo
+
+@page
+@unnumberedsec How to Apply These Terms to Your New Programs
+
+  If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+  To do so, attach the following notices to the program.  It is safest
+to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least
+the ``copyright'' line and a pointer to where the full notice is found.
+
+@smallexample
+@var{one line to give the program's name and a brief idea of what it does.}
+Copyright (C) 19@var{yy}  @var{name of author}
+
+This program 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 of the License, or 
+(at your option) any later version.
+
+This program 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 this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+@end smallexample
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+@smallexample
+Gnomovision version 69, Copyright (C) 19@var{yy} @var{name of author}
+Gnomovision comes with ABSOLUTELY NO WARRANTY; for details
+type `show w'.  
+This is free software, and you are welcome to redistribute it 
+under certain conditions; type `show c' for details.
+@end smallexample
+
+The hypothetical commands @samp{show w} and @samp{show c} should show
+the appropriate parts of the General Public License.  Of course, the
+commands you use may be called something other than @samp{show w} and
+@samp{show c}; they could even be mouse-clicks or menu items---whatever
+suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a ``copyright disclaimer'' for the program, if
+necessary.  Here is a sample; alter the names:
+
+@smallexample
+Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+`Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+@var{signature of Ty Coon}, 1 April 1989
+Ty Coon, President of Vice
+@end smallexample
+
+This General Public License does not permit incorporating your program into
+proprietary programs.  If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library.  If this is what you want to do, use the GNU Library General
+Public License instead of this License.
+
+@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 GNU CC compiler.
+@xref{Contributors,,Contributors to GNU CC,gcc,Using and Porting GNU CC},
+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 @code{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 @code{g77}'s
+public release.  This work consisted of testing, researching, sometimes
+debugging, and occasionally providing small amounts of code and fixes
+for @code{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
+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, because version 0.6 is still
+a ways off.
+
+@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 @code{g77} code generation to at least be as good
+as @code{f2c} used in conjunction with @code{gcc}.
+So far, this has resulted in the three, somewhat
+experimental, options added by @code{g77} to the @code{gcc}
+compiler and its back end.
+
+@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 @code{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
+
+@node Funding
+@chapter Funding Free Software
+
+If you want to have more free software a few years from now, it makes
+sense for you to help encourage people to contribute funds for its
+development.  The most effective approach known is to encourage
+commercial redistributors to donate.
+
+Users of free software systems can boost the pace of development by
+encouraging for-a-fee distributors to donate part of their selling price
+to free software developers---the Free Software Foundation, and others.
+
+The way to convince distributors to do this is to demand it and expect
+it from them.  So when you compare distributors, judge them partly by
+how much they give to free software development.  Show distributors
+they must compete to be the one who gives the most.
+
+To make this approach work, you must insist on numbers that you can
+compare, such as, ``We will donate ten dollars to the Frobnitz project
+for each disk sold.''  Don't be satisfied with a vague promise, such as
+``A portion of the profits are donated,'' since it doesn't give a basis
+for comparison.
+
+Even a precise fraction ``of the profits from this disk'' is not very
+meaningful, since creative accounting and unrelated business decisions
+can greatly alter what fraction of the sales price counts as profit.
+If the price you pay is $50, ten percent of the profit is probably
+less than a dollar; it might be a few cents, or nothing at all.
+
+Some redistributors do development work themselves.  This is useful too;
+but to keep everyone honest, you need to inquire how much they do, and
+what kind.  Some kinds of development make much more long-term
+difference than others.  For example, maintaining a separate version of
+a program contributes very little; maintaining the standard version of a
+program for the whole community contributes much.  Easy new ports
+contribute little, since someone else would surely do them; difficult
+ports such as adding a new CPU to the GNU C compiler contribute more;
+major new features or packages contribute the most.
+
+By establishing the idea that supporting further development is ``the
+proper thing to do'' when distributing free software for a fee, we can
+assure a steady flow of resources into making more free software.
+
+@display
+Copyright (C) 1994 Free Software Foundation, Inc.
+Verbatim copying and redistribution of this section is permitted
+without royalty; alteration is not permitted.
+@end display
+
+@node Funding GNU Fortran
+@chapter Funding GNU Fortran
+@cindex funding improvements
+@cindex improvements, funding
+
+Work on GNU Fortran is still being done mostly by its author,
+James Craig Burley (@email{burley@@gnu.ai.mit.edu}), who is a volunteer
+for, not an employee of, the Free Software Foundation (FSF).
+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@@prep.ai.mit.edu} for information on funding the FSF.
+
+To fund specific GNU Fortran work in particular, the FSF might
+provide a means for that, but the FSF does not provide direct funding
+to the author of GNU Fortran to continue his work.  The FSF has
+employee salary restrictions that can be incompatible with the
+financial needs of some volunteers, who therefore choose to
+remain volunteers and thus be able to be free to do contract work
+and otherwise make their own schedules for doing GNU work.
+
+Still, funding the FSF at least indirectly benefits work
+on specific projects like GNU Fortran because it ensures the
+continuing operation of the FSF offices, their workstations, their
+network connections, and so on, which are invaluable to volunteers.
+(Similarly, hiring Cygnus Support can help a project like GNU
+Fortran---Cygnus has been a long-time donor of equipment usage to the author
+of GNU Fortran, and this too has been invaluable---@xref{Contributors}.)
+
+Currently, the only way to directly fund the author of GNU Fortran
+in his work on that project is to hire him for the work you want
+him to do, or donate money to him.
+Several people have done this
+already, with the result that he has not needed to immediately find
+contract work on a few occasions.
+If more people did this, he
+would be able to plan on not doing contract work for many months and
+could thus devote that time to work on projects (such as the planned
+changes for 0.6) that require longer timeframes to complete.
+For the latest information on the status of the author, do
+@kbd{finger -l burley@@gate.gnu.ai.mit.edu} on a UNIX system
+(or any system with a command like UNIX @code{finger}).
+
+Another important way to support work on GNU Fortran is to volunteer
+to help out.
+Work is needed on documentation, testing, porting
+to various machines, and in some cases, coding (although major
+changes planned for version 0.6 make it difficult to add manpower to this
+area).
+Email @email{fortran@@gnu.ai.mit.edu} to volunteer for this work.
+
+@xref{Funding,,Funding Free Software}, for more information.
+
+@node Look and Feel
+@chapter Protect Your Freedom---Fight ``Look And Feel''
+@c the above chapter heading overflows onto the next line. --mew 1/26/93 
+
+To preserve the ability to write free software, including replacements
+for proprietary software, authors must be free to replicate the
+user interface to which users of existing software have become
+accustomed.
+
+@xref{Look and Feel,,Protect Your Freedom---Fight ``Look And Feel'',
+gcc,Using and Porting GNU CC}, 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 @code{gcc},
+you should see @ref{G77 and GCC}.
+
+Everyone except experienced @code{g77} users should
+see @ref{Invoking G77}.
+
+If you're acquainted with previous versions of @code{g77},
+you should see @ref{News}.
+Further, if you've actually used previous versions of @code{g77},
+especially if you've written or modified Fortran code to
+be compiled by previous versions of @code{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 don't already have @code{g77} installed on your
+system, you must see @ref{Installation}.
+
+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 @code{g77}---see @ref{Bugs}, for information on
+reporting them, after reading the other material.
+
+If you need further help with @code{g77}, or with
+freely redistributable software in general,
+see @ref{Service}.
+
+If you would like to help the @code{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
+@code{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 @code{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 @code{g77}, is designed initially as a free replacement
+for, or alternative to, the UNIX @code{f77} command.
+(Similarly, @code{gcc} is designed as a replacement
+for the UNIX @code{cc} command.)
+
+@code{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, @code{g77}, @code{gcc}, and @code{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 gdb command
+@cindex commands, 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 @code{gdb}).
+
+@cindex libraries
+@cindex linking
+@cindex ld command
+@cindex commands, 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
+@code{ld} command.
+However, the @code{g77} and @code{gcc}
+commands, as with most compiler commands, automatically
+perform the linking step by calling on @code{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 g77
+@cindex g77, components of
+@code{g77} consists of several components:
+
+@cindex gcc command
+@cindex commands, gcc
+@itemize @bullet
+@item
+A modified version of the @code{gcc} command, which also might be
+installed as the system's @code{cc} command.
+(In many cases, @code{cc} refers to the
+system's ``native'' C compiler, which
+might be a non-GNU compiler, or an older version
+of @code{gcc} considered more stable or that is
+used to build the operating system kernel.)
+
+@cindex g77 command
+@cindex commands, g77
+@item
+The @code{g77} command itself, which also might be installed as the
+system's @code{f77} command.
+
+@cindex libf2c library
+@cindex libraries, libf2c
+@cindex run-time library
+@item
+The @code{libf2c} 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 @code{g77}
+compilation phase.
+
+@cindex f771 program
+@cindex programs, f771
+@cindex assembler
+@cindex as command
+@cindex commands, 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 @code{as}.
+@end itemize
+
+@code{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, @code{gcc} determines which actions to perform, including
+preprocessing, compiling (in a variety of possible languages), assembling,
+and linking.
+
+@cindex driver, gcc command as
+@cindex 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 @code{cpp}, then
+the C compiler (internally named
+@code{cc1}), then the assembler (usually @code{as}), then the linker
+(@code{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},
+@code{gcc} would use the C++ compiler (named @code{cc1plus}).
+
+@cindex f771 program
+@cindex programs, f771
+In a GNU Fortran installation, @code{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 gcc not recognizing Fortran source
+@cindex unrecognized file format
+@cindex file format not recognized
+Non-Fortran-related operation of @code{gcc} is generally
+unaffected by installing the GNU Fortran version of @code{gcc}.
+However, without the installed version of @code{gcc} being the
+GNU Fortran version, @code{gcc} will not be able to compile
+and link Fortran programs---and since @code{g77} uses @code{gcc}
+to do most of the actual work, neither will @code{g77}!
+
+@cindex g77 command
+@cindex commands, g77
+The @code{g77} command is essentially just a front-end for
+the @code{gcc} command.
+Fortran users will normally use @code{g77} instead of @code{gcc},
+because @code{g77}
+knows how to specify the libraries needed to link with Fortran programs
+(@code{libf2c} and @code{lm}).
+@code{g77} can still compile and link programs and
+source files written in other languages, just like @code{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 @code{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 @code{gcc}
+with which that version of @code{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 @code{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 @code{g77} when compiling Fortran code) into machine
+code that, when run, calls on functions in @code{libf2c}, so
+@code{libf2c} must be linked with almost every useful program
+having any component compiled by GNU Fortran.
+(As mentioned above, the @code{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{libf2c} component is really part of @code{f2c},
+a free Fortran-to-C converter distributed by Bellcore (AT&T),
+plus @code{libU77}, provided by Dave Love,
+and the @code{g77} command is just a small front-end to @code{gcc},
+@code{f771} is a combination of two rather
+large chunks of code.
+
+@cindex GNU Back End (GBE)
+@cindex GBE
+@cindex 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 g77 front end
+@cindex front end, 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 @samp{-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 gcc command
+@cindex commands, gcc
+A GNU Fortran installation includes a modified version of the @code{gcc}
+command.
+
+In a non-Fortran installation, @code{gcc} recognizes C, C++,
+and Objective-C source files.
+
+In a GNU Fortran installation, @code{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,,Compile C; C++; or Objective-C,gcc,Using and Porting GNU CC},
+for information on the way different languages are handled
+by the GNU CC compiler (@code{gcc}).
+
+@cindex g77 command
+@cindex commands, g77
+Also provided as part of GNU Fortran is the @code{g77} command.
+The @code{g77} command is designed to make compiling and linking Fortran
+programs somewhat easier than when using the @code{gcc} command for
+these tasks.
+It does this by analyzing the command line somewhat and changing it
+appropriately before submitting it to the @code{gcc} command.
+
+@cindex -v option
+@cindex g77 options, -v
+@cindex options, -v
+@cindex -@w{}-driver option
+@cindex g77 options, -@w{}-driver
+@cindex options, -@w{}-driver
+Use the @samp{-v} option with @code{g77}
+to see what is going on---the first line of output is the invocation
+of the @code{gcc} command.
+Use @samp{--driver=true} to disable actual invocation
+of @code{gcc} (this works because @samp{true} is the name of a
+UNIX command that simply returns success status).
+
+@node Invoking G77
+@chapter GNU Fortran Command Options
+@cindex GNU Fortran command options
+@cindex command options
+@cindex options, GNU Fortran command
+
+The @code{g77} command supports all the options supported by the
+@code{gcc} command.
+@xref{Invoking GCC,,GNU CC Command Options,gcc,Using and Porting GNU CC},
+for information
+on the non-Fortran-specific aspects of the @code{gcc} command (and,
+therefore, the @code{g77} command).
+
+The @code{g77} command supports one option not supported by
+the @code{gcc} command:
+
+@table @code
+@cindex -@w{}-driver option
+@cindex g77 options, -@w{}-driver
+@cindex options, -@w{}-driver
+@item --driver=@var{command}
+Specifies that @var{command}, rather than @code{gcc}, is to
+be invoked by @code{g77} to do its job.
+For example, within the @code{gcc} build directory after
+building GNU Fortran (but without having to install it),
+@kbd{./g77 --driver=./xgcc foo.f -B./}.
+@end table
+
+@cindex options, negative forms
+@cindex negative forms of options
+All other options are supported both by @code{g77} and by @code{gcc} as
+modified (and reinstalled) by the @code{g77} distribution.
+In some cases, options have positive and negative forms;
+the negative form of @samp{-ffoo} would be @samp{-fno-foo}.
+This manual documents only one of these two forms, whichever
+one is not the default.
+
+@menu
+* Option Summary::      Brief list of all @code{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
+
+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}.
+@smallexample
+--driver  -fversion  -fset-g77-defaults  -fno-silent
+@end smallexample
+
+@item Shorthand Options
+@xref{Shorthand Options}.
+@smallexample
+-ff66  -fno-f66  -ff77  -fno-f77  -fugly  -fno-ugly
+@end smallexample
+
+@item Fortran Language Options
+@xref{Fortran Dialect Options,,Options Controlling Fortran Dialect}.
+@smallexample
+-ffree-form  -fno-fixed-form  -ff90
+-fvxt  -fdollar-ok  -fno-backslash
+-fno-ugly-args  -fno-ugly-assign  -fno-ugly-assumed
+-fugly-comma  -fugly-complex  -fugly-init  -fugly-logint
+-fonetrip  -ftypeless-boz
+-fintrin-case-initcap  -fintrin-case-upper
+-fintrin-case-lower  -fintrin-case-any
+-fmatch-case-initcap  -fmatch-case-upper
+-fmatch-case-lower  -fmatch-case-any
+-fsource-case-upper -fsource-case-lower  -fsource-case-preserve
+-fsymbol-case-initcap  -fsymbol-case-upper
+-fsymbol-case-lower  -fsymbol-case-any
+-fcase-strict-upper  -fcase-strict-lower
+-fcase-initcap  -fcase-upper  -fcase-lower  -fcase-preserve
+-ff2c-intrinsics-delete  -ff2c-intrinsics-hide
+-ff2c-intrinsics-disable  -ff2c-intrinsics-enable
+-ff90-intrinsics-delete  -ff90-intrinsics-hide
+-ff90-intrinsics-disable  -ff90-intrinsics-enable
+-fgnu-intrinsics-delete  -fgnu-intrinsics-hide
+-fgnu-intrinsics-disable  -fgnu-intrinsics-enable
+-fmil-intrinsics-delete  -fmil-intrinsics-hide
+-fmil-intrinsics-disable  -fmil-intrinsics-enable
+-funix-intrinsics-delete  -funix-intrinsics-hide
+-funix-intrinsics-disable  -funix-intrinsics-enable
+-fvxt-intrinsics-delete  -fvxt-intrinsics-hide
+-fvxt-intrinsics-disable  -fvxt-intrinsics-enable
+-ffixed-line-length-@var{n}  -ffixed-line-length-none
+@end smallexample
+
+@item Warning Options
+@xref{Warning Options,,Options to Request or Suppress Warnings}.
+@smallexample
+-fsyntax-only  -pedantic  -pedantic-errors  -fpedantic
+-w  -Wno-globals  -Wimplicit -Wunused  -Wuninitialized
+-Wall  -Wsurprising
+-Werror  -W
+@end smallexample
+
+@item Debugging Options
+@xref{Debugging Options,,Options for Debugging Your Program or GCC}.
+@smallexample
+-g
+@end smallexample
+
+@item Optimization Options
+@xref{Optimize Options,,Options that Control Optimization}.
+@smallexample
+-malign-double
+-ffloat-store  -fforce-mem  -fforce-addr  -fno-inline
+-ffast-math  -fstrength-reduce  -frerun-cse-after-loop
+-fexpensive-optimizations  -fdelayed-branch
+-fschedule-insns  -fschedule-insn2  -fcaller-saves
+-funroll-loops  -funroll-all-loops
+-fno-move-all-movables  -fno-reduce-all-givs
+-fno-rerun-loop-opt
+@end smallexample
+
+@item Directory Options
+@xref{Directory Options,,Options for Directory Search}.
+@smallexample
+-I@var{dir}  -I-
+@end smallexample
+
+@item Code Generation Options
+@xref{Code Gen Options,,Options for Code Generation Conventions}.
+@smallexample
+-fno-automatic  -finit-local-zero  -fno-f2c
+-ff2c-library  -fno-underscoring  -fno-ident
+-fpcc-struct-return  -freg-struct-return
+-fshort-double  -fno-common  -fpack-struct
+-fzeros  -fno-second-underscore
+-fdebug-kludge  -fno-emulate-complex
+-falias-check  -fargument-alias
+-fargument-noalias  -fno-argument-noalias-global
+-fno-globals
+@end smallexample
+@end table
+
+@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
+
+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,,gcc,Using and Porting GNU CC}, for
+information on suffixes recognized by GNU CC.
+
+@table @code
+@item @var{file}.f
+@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.
+
+@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
+@item @var{file}.F
+@item @var{file}.fpp
+Fortran source code that must be preprocessed (by the C preprocessor
+@code{cpp}, which is part of GNU CC).
+
+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, ratfor
+@cindex .r filename suffix
+@item @var{file}.r
+Ratfor source code, which must be preprocessed by the @code{ratfor}
+command, which is available separately (as it is not yet part of
+the GNU Fortran distribution).
+@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 @code{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.
+
+@emph{Note:} The @samp{-traditional} and @samp{-undef} flags are supplied
+to @code{cpp} by default, to avoid unpleasant surprises.
+@xref{Preprocessor Options,,Options Controlling the Preprocessor,
+gcc,Using and Porting GNU CC}.
+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 @samp{-v} option to see exactly how the preprocessor is invoked.
+
+The following options that affect overall processing are recognized
+by the @code{g77} and @code{gcc} commands in a GNU Fortran installation:
+
+@table @code
+@item --driver=@var{command}
+This works when invoking only the @code{g77} command, not
+when invoking the @code{gcc} command.
+@xref{Invoking G77,,GNU Fortran Command Options}, for
+information on this option.
+
+@cindex -fversion option
+@cindex options, -fversion
+@cindex printing version information
+@cindex version information, printing
+@item -fversion
+Ensure that the @code{g77}-specific version of the compiler phase is reported,
+if run.
+(This is supplied automatically when @samp{-v} or @samp{--verbose}
+is specified as a command-line option for @code{g77} or @code{gcc}
+and when the resulting commands compile Fortran source files.)
+
+@cindex -fset-g77-defaults option
+@cindex options, -fset-g77-defaults
+@item -fset-g77-defaults
+Set up whatever @code{gcc} options are to apply to Fortran
+compilations, and avoid running internal consistency checks
+that might take some time.
+
+As of version 0.5.20, this is equivalent to @samp{-fmove-all-movables
+-freduce-all-givs -frerun-loop-opt -fargument-noalias-global}.
+
+This option is supplied automatically when compiling Fortran code
+via the @code{g77} or @code{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 g77
+@cindex code, 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 @code{g77} or @code{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---@code{g77} will crash
+with a diagnostic if it detects an inconsistency.
+
+@cindex -fno-silent option
+@cindex options, -fno-silent
+@cindex @code{f2c} compatibility
+@cindex compatibility, @code{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 @code{f77} implementations and @code{f2c}.
+@end table
+
+@xref{Overall Options,,Options Controlling the Kind of Output,
+gcc,Using and Porting GNU CC}, for information
+on more options that control the overall operation of the @code{gcc} command
+(and, by extension, the @code{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 @code
+@cindex -fugly option
+@cindex options, -fugly
+@item -fugly
+@cindex ugly features
+@cindex features, ugly
+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.
+
+@emph{Note:} The @samp{-fugly} option is likely to
+be removed in a future version.
+Implicitly enabling all the @samp{-fugly-*} options
+is unlikely to be feasible, or sensible, in the future,
+so users should learn to specify only those
+@samp{-fugly-*} options they really need for a
+particular source file.
+
+@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 @samp{-fno-f66} option is the inverse of @samp{-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 @code{g77} provide more compatibility with other
+existing and obsolete Fortran implementations.
+
+@cindex -ff77 option
+@cindex options, -ff77
+@item -ff77
+@cindex UNIX f77
+@cindex @code{f2c} compatibility
+@cindex compatibility, @code{f2c}
+@cindex @code{f77} compatibility
+@cindex compatibility, @code{f77}
+Specify that the program is written in idiomatic UNIX FORTRAN 77
+and/or the dialect accepted by the @code{f2c} product.
+Same as @samp{-fbackslash -fno-typeless-boz}.
+
+The meaning of this option is likely to be refined as future
+versions of @code{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 @samp{-fno-f77} option is @emph{not} the inverse
+of @samp{-ff77}.
+It specifies that the program is not written in idiomatic UNIX
+FORTRAN 77 or @code{f2c}, but in a more widely portable dialect.
+@samp{-fno-f77} is the same as @samp{-fno-backslash}.
+
+The meaning of this option is likely to be refined as future
+versions of @code{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 @code
+@cindex -ffree-form option
+@cindex options, -ffree-form
+@cindex -fno-fixed-form option
+@cindex options, -fno-fixed-form
+@cindex source file form
+@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
+@samp{-fvxt}, @samp{-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 features
+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 @samp{-fno-vxt}.
+@samp{-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 @samp{-fbackslash} in effect, @samp{A\nB} specifies
+three characters, with the second one being newline.
+With @samp{-fno-backslash}, it specifies four characters,
+@samp{A}, @samp{\}, @samp{n}, and @samp{B}.
+
+Note that @code{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 @code{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 @samp{-fbackslash} is the default
+instead of @samp{-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
+Treat a trailing comma in an 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 @samp{-fugly-comma} is in force.
+And @samp{F = FUNC()} is treated as @samp{F = FUNC(%VAL(0))}.
+
+The default behavior, @samp{-fno-ugly-comma}, is to ignore
+a single trailing comma in an argument list.
+
+@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 @samp{-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
+@samp{-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 DO loops, one-trip
+@cindex one-trip DO loops
+@cindex compatibility, FORTRAN 66
+Imperative executable @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 imperative @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 @samp{-fonetrip} option specifies that the source file(s) being
+compiled require one-trip loops.
+
+This option affects only those loops specified by the (imperative) @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.
+@samp{-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.
+@samp{-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.
+@samp{-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.
+@samp{-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 -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 f2c intrinsics
+@cindex intrinsics, f2c
+Specify status of f2c-specific intrinsics.
+@samp{-ff2c-intrinsics-enable} is the default.
+
+@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.
+@samp{-ff90-intrinsics-enable} is the default.
+
+@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 COMPLEX intrinsics
+@cindex intrinsics, COMPLEX
+Specify status of Digital's COMPLEX-related intrinsics.
+@samp{-fgnu-intrinsics-enable} is the default.
+
+@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.
+@samp{-fmil-intrinsics-enable} is the default.
+
+@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.
+@samp{-funix-intrinsics-enable} is the default.
+
+@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.
+@samp{-fvxt-intrinsics-enable} is the default.
+
+@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 line length
+@cindex length of source lines
+@cindex fixed-form line length
+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.
+@samp{-ffixed-line-length-0} means the same thing as
+@samp{-ffixed-line-length-none}.
+
+@xref{Source Form}, for more information.
+@end table
+
+@node Warning Options
+@section Options to Request or Suppress Warnings
+@cindex options to control warnings
+@cindex warning messages
+@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 @samp{-W},
+for example @samp{-Wimplicit} to request warnings on implicit
+declarations.  Each of these specific warning options also has a
+negative form beginning @samp{-Wno-} to turn off warnings;
+for example, @samp{-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 @code
+@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.
+@samp{-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 @samp{-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 @code{g77} in this area are welcome.
+
+@cindex -pedantic-errors option
+@cindex options, -pedantic-errors
+@item -pedantic-errors
+Like @samp{-pedantic}, except that errors are produced rather than
+warnings.
+
+@cindex -fpedantic option
+@cindex options, -fpedantic
+@item -fpedantic
+Like @samp{-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 @samp{-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 @samp{-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 @samp{-Wunused} and @samp{-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 @code{g77}, some might
+be added to the list enabled by @samp{-Wall}.)
+@end table
+
+The remaining @samp{-W@dots{}} options are not implied by @samp{-Wall}
+because they warn about constructions that we consider reasonable to
+use, on occasion, in clean programs.
+
+@table @code
+@c @item -W
+@c Print extra warning messages for these events:
+@c 
+@c @itemize @bullet
+@c @item
+@c If @samp{-Wall} or @samp{-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}.
+@code{g77}, along with many other compilers, interprets
+this example differently than many programmers, and a few
+other compilers.
+Specifically, @code{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 @code{g77} evaluates to .25, while others might evaluate
+it to 0., the difference resulting from the way precedence affects
+type promotion.
+
+(The @samp{-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 @code{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 @samp{-O}, the @samp{-Wuninitialized} option.
+(This might change in future versions of @code{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 @samp{-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 and Porting GNU CC}, for information on more options offered
+by the GBE shared by @code{g77}, @code{gcc}, and other GNU compilers.
+
+Some of these have no effect when compiling programs written in Fortran:
+
+@table @code
+@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 -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 @code{g77}.
+
+@table @code
+@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.
+
+@cindex common blocks
+@cindex equivalence areas
+@cindex missing debug features
+Support for this option in Fortran programs is incomplete.
+In particular, names of variables and arrays in common blocks
+or that are storage-associated via @code{EQUIVALENCE} are
+unavailable to the debugger.
+
+However, version 0.5.19 of @code{g77} does provide this information
+in a rudimentary way, as controlled by the
+@samp{-fdebug-kludge} option.
+
+@xref{Code Gen Options,,Options for Code Generation Conventions},
+for more information.
+@end table
+
+@xref{Debugging Options,,Options for Debugging Your Program or GNU CC,
+gcc,Using and Porting GNU CC}, 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 @samp{-O} or @samp{-O2} when
+compiling programs for late-cycle testing and for production use.
+
+The following flags have particular applicability when
+compiling Fortran programs:
+
+@table @code
+@cindex -malign-double option
+@cindex options, -malign-double
+@item -malign-double
+(Intel 386 architecture only.)
+
+Noticeably improves performance of @code{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 @code{gcc} documentation about
+this option does not apply, generally speaking, to Fortran
+code compiled by @code{g77}.
+
+@emph{Also note:} Apparently due to a @code{gcc} backend bug,
+@samp{-malign-double} does not align stack-allocated data (such as
+local variables neither @code{SAVE}d nor reckoned to take up too
+much space to put on the stack).
+
+@emph{Also also note:} The negative form of @samp{-malign-double}
+is @samp{-mno-align-double}, not @samp{-benign-double}.
+
+@cindex -ffloat-store option
+@cindex options, -ffloat-store
+@item -ffloat-store
+@cindex IEEE conformance
+@cindex conformance, IEEE
+Might help a Fortran program that depends on exact IEEE conformance
+on some machines, but might slow down a program that doesn't.
+
+@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 speeding up loops
+Might improve optimization of loops.
+
+@cindex -fno-inline option
+@cindex options, -fno-inline
+@item -fno-inline
+@cindex in-line compilation
+@cindex compilation, in-line
+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 conformance
+@cindex conformance, IEEE
+Might allow some programs designed to not be too dependent
+on IEEE behavior for floating-point to run faster, or die trying.
+
+@cindex -fstrength-reduce option
+@cindex options, -fstrength-reduce
+@item -fstrength-reduce
+@cindex loops, speeding up
+@cindex speeding up loops
+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
+@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
+Definitely improves performance on some code.
+
+@cindex -funroll-all-loops option
+@cindex options, -funroll-all-loops
+@item -funroll-all-loops
+Definitely improves performance on some code.
+
+@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
+Each of these might improve performance on some code.
+
+Analysis of Fortran code optimization and the resulting
+optimizations triggered by the above options were
+contributed by Toon Moene (@email{toon@@moene.indiv.nluug.nl}).
+
+These three options are intended to be removed someday, once
+they have helped determine the efficacy of various
+approaches to improving the performance of Fortran code.
+
+Please let us know how use of these options affects
+the performance of your production code.
+We're particularly interested in code that runs faster
+when these options are @emph{disabled}, and in
+non-Fortran code that benefits when they are
+@emph{enabled} via the above @code{gcc} command-line options.
+@end table
+
+@xref{Optimize Options,,Options That Control Optimization,
+gcc,Using and Porting GNU CC}, 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 and Porting GNU CC}, for information on C preprocessor options.
+
+@cindex INCLUDE directive
+@cindex directive, INCLUDE
+Some of these options also affect how @code{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 @code{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 @code{cpp} preprocessor searches
+for files specified via the @code{#include} directive.
+Therefore, when compiling Fortran programs, they are meaningful
+when the preproecssor is used.
+
+@cindex INCLUDE directive
+@cindex directive, INCLUDE
+Some of these options also affect how @code{g77} searches
+for files specified via the @code{INCLUDE} directive,
+although files included by that directive are not,
+themselves, preprocessed.
+These options are:
+
+@table @code
+@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 searching for included files
+These affect interpretation of the @code{INCLUDE} directive
+(as well as of the @code{#include} directive of the @code{cpp}
+preprocessor).
+
+Note that @samp{-I@var{dir}} must be specified @emph{without} any
+spaces between @samp{-I} and the directory name---that is,
+@samp{-Ifoo/bar} is valid, but @samp{-I foo/bar}
+is rejected by the @code{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 @samp{-I} and
+@code{INCLUDE} is pretty much the same as of @samp{-I} with
+@code{#include} in the @code{cpp} preprocessor, with regard to
+looking for @file{header.gcc} files and other such things.
+
+@xref{Directory Options,,Options for Directory Search,
+gcc,Using and Porting GNU CC}, for information on the @samp{-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 @samp{-ffoo} would be @samp{-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 @samp{no-} or adding
+it.
+
+@table @code
+@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 @samp{-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 @samp{-fno-automatic} with @samp{-finit-local-zero}.
+
+@cindex -fno-f2c option
+@cindex options, -fno-f2c
+@item -fno-f2c
+@cindex @code{f2c} compatibility
+@cindex compatibility, @code{f2c}
+Do not generate code designed to be compatible with code generated
+by @code{f2c}; use the GNU calling conventions instead.
+
+The @code{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{libf2c} library.
+
+However, because the @code{libf2c} library uses @code{f2c}
+calling conventions, @code{g77} rejects attempts to pass
+intrinsics implemented by routines in this library as actual
+arguments when @samp{-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 @samp{-fno-f2c} is in force.
+(Future versions of the @code{g77} run-time library might
+offer routines that provide GNU-callable versions of the
+routines that implement the @code{f2c}-callable intrinsics
+that may be passed as actual arguments, so that
+valid programs need not be rejected when @samp{-fno-f2c}
+is used.)
+
+@strong{Caution:} If @samp{-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{libf2c} is required.
+This is the default for the current version of @code{g77}.
+
+Currently it is not
+valid to specify @samp{-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 @code{g77} that might otherwise default to
+generating code for an incompatible library.
+
+@cindex -fno-underscoring option
+@cindex options, -fno-underscoring
+@item -fno-underscoring
+@cindex underscores
+@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 @samp{-funderscoring} in effect, @code{g77} appends two underscores
+to names with underscores and one underscore to external names with
+no underscores.  (@code{g77} also appends two underscores to internal
+names with underscores to avoid naming collisions with external names.
+The @samp{-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 @code{f2c}, which perform the
+same transformations.
+
+Use of @samp{-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 @samp{-funderscoring}, and assuming other defaults like
+@samp{-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 @samp{-fno-underscoring}, the same statement is implemented as:
+
+@smallexample
+i = j() + max_count(&my_var, &lvar);
+@end smallexample
+
+Use of @samp{-fno-underscoring} allows direct specification of
+user-defined names while debugging and when interfacing @code{g77}-compiled
+code with other languages.
+
+Note that just because the names match does @emph{not} mean that the
+interface implemented by @code{g77} for an external name matches the
+interface implemented by some other language for that same name.
+That is, getting code produced by @code{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 @samp{-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 @code{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 underscores
+@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 @samp{-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, @code{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 @samp{-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 @code{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 -fdebug-kludge option
+@cindex options, -fdebug-kludge
+@item -fdebug-kludge
+Emit information on @code{COMMON} and @code{EQUIVALENCE} members
+that might help users of debuggers work around lack of proper debugging
+information on such members.
+
+As of version 0.5.19, @code{g77} offers this option to emit
+information on members of aggregate areas to help users while debugging.
+This information consists of establishing the type and contents of each
+such member so that, when a debugger is asked to print the contents,
+the printed information provides rudimentary debugging information.
+This information identifies the name of the aggregate area (either the
+@code{COMMON} block name, or the @code{g77}-assigned name for the
+@code{EQUIVALENCE} name) and the offset, in bytes, of the member from
+the beginning of the area.
+
+Using @code{gdb}, this information is not coherently displayed in the Fortran
+language mode, so temporarily switching to the C language mode to display the
+information is suggested.
+Use @samp{set language c} and @samp{set language fortran} to accomplish this.
+
+For example:
+
+@smallexample
+      COMMON /X/A,B
+      EQUIVALENCE (C,D)
+      CHARACTER XX*50
+      EQUIVALENCE (I,XX(20:20))
+      END
+
+GDB is free software and you are welcome to distribute copies of it
+ under certain conditions; type "show copying" to see the conditions.
+There is absolutely no warranty for GDB; type "show warranty" for details.
+GDB 4.16 (lm-gnits-dwim), Copyright 1996 Free Software Foundation, Inc...
+(gdb) b MAIN__
+Breakpoint 1 at 0t1200000201120112: file cd.f, line 5.
+(gdb) r
+Starting program: /home/user/a.out
+
+Breakpoint 1, MAIN__ () at cd.f:5
+Current language:  auto; currently fortran
+(gdb) set language c
+Warning: the current language does not match this frame.
+(gdb) p a
+$2 = "At (COMMON) `x_' plus 0 bytes"
+(gdb) p b
+$3 = "At (COMMON) `x_' plus 4 bytes"
+(gdb) p c
+$4 = "At (EQUIVALENCE) `__g77_equiv_c' plus 0 bytes"
+(gdb) p d
+$5 = "At (EQUIVALENCE) `__g77_equiv_c' plus 0 bytes"
+(gdb) p i
+$6 = "At (EQUIVALENCE) `__g77_equiv_xx' plus 20 bytes"
+(gdb) p xx
+$7 = "At (EQUIVALENCE) `__g77_equiv_xx' plus 1 bytes"
+(gdb) set language fortran
+(gdb) 
+@end smallexample
+
+@noindent
+Use @samp{-fdebug-kludge} to generate this information,
+which might make some programs noticeably larger.
+
+@emph{Caution:} Future versions of @code{g77} might disregard this option
+(and its negative form).
+Current plans call for this to happen when published versions of @code{g77}
+and @code{gdb} exist that provide proper access to debugging information on
+@code{COMMON} and @code{EQUIVALENCE} members.
+
+@cindex -fno-emulate-complex option
+@cindex options, -fno-emulate-complex
+@item -fno-emulate-complex
+Implement @code{COMPLEX} arithmetic using the facilities in
+the @code{gcc} back end that provide direct support of
+@code{complex} arithmetic, instead of emulating the arithmetic.
+
+@code{gcc} has some known problems in its back-end support
+for @code{complex} arithmetic, due primarily to the support not being
+completed as of version 2.7.2.2.
+Other front ends for the @code{gcc} back end avoid this problem
+by emulating @code{complex} arithmetic at a higher level, so the
+back end sees arithmetic on the real and imaginary components.
+To make @code{g77} more portable to systems where @code{complex}
+support in the @code{gcc} back end is particularly troublesome,
+@code{g77} now defaults to performing the same kinds of emulations
+done by these other front ends.
+
+Use @samp{-fno-emulate-complex} to try the @code{complex} support
+in the @code{gcc} back end, in case it works and produces faster
+programs.
+So far, all the known bugs seem to involve compile-time crashes,
+rather than the generation of incorrect code.
+
+Use of this option should not affect how Fortran code compiled
+by @code{g77} works in terms of its interfaces to other code,
+e.g. that compiled by @code{f2c}.
+
+@emph{Caution:} Future versions of @code{g77} are likely to change
+the default for this option to
+@samp{-fno-emulate-complex}, and perhaps someday ignore both forms
+of this option.
+
+Also, it is possible that use of the @samp{-fno-emulate-complex} option
+could result in incorrect code being silently produced by @code{g77}.
+But, this is generally true of compilers anyway, so, as usual, test
+the programs you compile before assuming they are working.
+
+@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
+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 @samp{-fargument-noalias-global}.
+The default for code written in the C language family is
+@samp{-fargument-alias}.
+
+Note that, on some systems, compiling with @samp{-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
+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 @samp{-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 @code{g77} exposes via a
+diagnostic.
+
+Use of this option therefore has the effect of
+instructing @code{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, @code{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.
+@end table
+
+@xref{Code Gen Options,,Options for Code Generation Conventions,
+gcc,Using and Porting GNU CC}, for information on more options
+offered by the GBE
+shared by @code{g77}, @code{gcc}, and other GNU compilers.
+
+Some of these do @emph{not} work when compiling programs written in Fortran:
+
+@table @code
+@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{libf2c} with which
+you will be linking all code compiled by @code{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{libf2c} library,
+at the very least, even if it is built with the same option.
+@end table
+
+@node Environment Variables
+@section Environment Variables Affecting GNU Fortran
+@cindex environment variables
+
+GNU Fortran currently does not make use of any environment
+variables to control its operation above and beyond those
+that affect the operation of @code{gcc}.
+
+@xref{Environment Variables,,Environment Variables Affecting GNU CC,
+gcc,Using and Porting GNU CC}, for information on environment
+variables.
+
+@include news.texi
+
+@node Changes
+@chapter User-visible Changes
+@cindex versions, recent
+@cindex recent versions
+@cindex changes, user-visible
+@cindex user-visible changes
+
+This section describes changes to @code{g77} that are visible
+to the programmers who actually write and maintain Fortran
+code they compile with @code{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 @code{g77}.
+@xref{News,,News About GNU Fortran}, for information on
+such changes to @code{g77}.
+
+To find out about existing bugs and ongoing plans for GNU
+Fortran, retrieve @url{ftp://alpha.gnu.ai.mit.edu/g77.plan}
+or, if you cannot do that, email
+@email{fortran@@gnu.ai.mit.edu} asking for a recent copy of the
+GNU Fortran @file{.plan} file.
+
+@heading In 0.5.21:
+@itemize @bullet
+@item
+When the @samp{-W} option is specified, @code{gcc}, @code{g77},
+and other GNU compilers that incorporate the @code{gcc}
+back end as modified by @code{g77}, issue
+a warning about integer division by constant zero.
+
+@item
+New option @samp{-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 @code{g77}.
+
+@item
+New option @samp{-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 @samp{-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.
+
+@item
+Fix @code{libU77} routines that accept file names
+to strip trailing spaces from them, for consistency
+with other implementations.
+
+@item
+Fix @code{SIGNAL} intrinsic so it accepts an
+optional third @samp{Status} argument.
+
+@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}.
+
+@item
+Add options @samp{-fbadu77-intrinsics-delete},
+@samp{-fbadu77-intrinsics-hide}, and so on.
+
+@item
+Add @code{INT2} and @code{INT8} intrinsics.
+
+@item
+Add @code{CPU_TIME} intrinsic.
+
+@item
+@code{CTIME} intrinsic now accepts any @code{INTEGER}
+argument, not just @code{INTEGER(KIND=2)}.
+@end itemize
+
+@heading In 0.5.20:
+@itemize @bullet
+@item
+The @samp{-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 @samp{-ftypeless-boz} to cause such
+constants to be interpreted as typeless.
+
+(Version 0.5.19 introduced @samp{-fno-typeless-boz} and
+its inverse.)
+
+@xref{Fortran Dialect Options,,Options Controlling Fortran Dialect},
+for information on the @samp{-ftypeless-boz} option.
+
+@item
+Options @samp{-ff90-intrinsics-enable} and
+@samp{-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, @samp{-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 @samp{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 @samp{ALWAYS_FLUSH} defined,
+you will have to modify @code{libf2c} accordingly before
+building it from this and future versions of @code{g77}.
+
+@xref{Output Assumed To Flush}, for more information.
+
+@item
+Dave Love's implementation of @code{libU77} has been
+added to the version of @code{libf2c} distributed with
+and built by @code{g77}.
+@code{g77} now knows about the routines in this library
+as intrinsics.
+
+@item
+New option @samp{-fvxt} specifies that the
+source file is written in VXT Fortran, instead of GNU Fortran.
+
+@xref{VXT Fortran}, for more information on the constructs
+recognized when the @samp{-fvxt} option is specified.
+
+@item
+The @samp{-fvxt-not-f90} option has been deleted,
+along with its inverse, @samp{-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 @code{g77}.
+
+@xref{Other Dialects}, for more information.
+
+@item
+The @samp{-fugly} option now issues a warning, as it
+likely will be removed in a future version.
+
+(Enabling all the @samp{-fugly-*} options is unlikely
+to be feasible, or sensible, in the future,
+so users should learn to specify only those
+@samp{-fugly-*} options they really need for a
+particular source file.)
+
+@item
+The @samp{-fugly-assumed} option, introduced in
+version 0.5.19, has been changed to
+better accommodate old and new code.
+@xref{Ugly Assumed-Size Arrays}, for more information.
+
+@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 systems, this won't make a noticable 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 @code{g77} front
+end, to avoid bugs in @code{complex} support in the
+@code{gcc} back end.
+New option @samp{-fno-emulate-complex}
+causes @code{g77} to revert the 0.5.19 behavior.
+
+@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 @samp{-fforce-addr}
+also is specified.
+
+New options @samp{-falias-check}, @samp{-fargument-alias},
+@samp{-fargument-noalias},
+and @samp{-fno-argument-noalias-global} control the
+way @code{g77} handles potential aliasing.
+
+@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 @code{g77}.
+
+@item
+New option @samp{-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, @code{g77} uses a separate memory location
+to hold assigned statement labels.)
+
+@xref{Ugly Assigned Labels}, for more information.
+
+@item
+@code{FORMAT} and @code{ENTRY} statements now are allowed to
+precede @code{IMPLICIT NONE} statements.
+
+@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 @code{f2c} users
+may make full use of its features via the @code{g77}
+version of @file{f2c.h} and the @code{INTEGER(KIND=2)}
+support routines in the @code{g77} version of @code{libf2c}.
+
+@item
+Improve @code{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, @samp{gnu}, has been added
+to contain the new @code{REALPART}, @code{IMAGPART},
+and @code{COMPLEX} intrinsics.
+An old group, @samp{dcp}, has been removed.
+@end itemize
+
+@heading In 0.5.19:
+
+@itemize @bullet
+@item
+A temporary kludge option provides bare-bones information on
+@code{COMMON} and @code{EQUIVALENCE} members at debug time.
+@xref{Code Gen Options,,Options for Code Generation Conventions},
+for information on the @samp{-fdebug-kludge} option.
+
+@item
+New @samp{-fonetrip} option specifies FORTRAN-66-style
+one-trip @code{DO} loops.
+
+@item
+New @samp{-fno-silent} option causes names of program units
+to be printed as they are compiled, in a fashion similar to
+UNIX @code{f77} and @code{f2c}.
+
+@item
+New @samp{-fugly-assumed} option specifies that arrays
+dimensioned via @samp{DIMENSION X(1)}, for example, are to be
+treated as assumed-size.
+
+@item
+New @samp{-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(KIND=1)} constants.
+
+@item
+New @samp{-ff66} option is a ``shorthand'' option that specifies
+behaviors considered appropriate for FORTRAN 66 programs.
+
+@item
+New @samp{-ff77} option is a ``shorthand'' option that specifies
+behaviors considered appropriate for UNIX @code{f77} programs.
+
+@item
+New @samp{-fugly-comma} and @samp{-fugly-logint} options provided
+to perform some of what @samp{-fugly} used to do.
+@samp{-fugly} and @samp{-fno-ugly} are now ``shorthand'' options,
+in that they do nothing more than enable (or disable) other
+@samp{-fugly-*} options.
+
+@item
+Change code generation for list-directed I/O so it allows
+for new versions of @code{libf2c} that might return non-zero
+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
+Add options @samp{--help} and @samp{--version} to the
+@code{g77} command, to conform to GNU coding guidelines.
+Also add printing of @code{g77} version number when
+the @samp{--verbose} (@samp{-v}) option is used.
+@end itemize
+
+@heading In 0.5.18:
+
+@itemize @bullet
+@item
+The @code{BYTE} and @code{WORD} statements now are supported,
+to a limited extent.
+
+@item
+@code{INTEGER*1}, @code{INTEGER*2}, @code{INTEGER*8},
+and their @code{LOGICAL}
+equivalents, now are supported to a limited extent.
+Among the missing elements are complete intrinsic and constant
+support.
+
+@item
+Support automatic arrays in procedures.
+For example, @samp{REAL A(N)}, where @samp{A} is
+not a dummy argument, specifies that @samp{A} is
+an automatic array.
+The size of @samp{A} is calculated from the value
+of @samp{N} each time the procedure is called,
+that amount of space is allocated, and that space
+is freed when the procedure returns to its caller.
+
+@item
+Add @samp{-fno-zeros} option, enabled by default,
+to reduce compile-time CPU and memory usage for
+code that provides initial zero values for variables
+and arrays.
+
+@item
+Introduce three new options that apply to all compilations
+by @code{g77}-aware GNU compilers---@samp{-fmove-all-movables},
+@samp{-freduce-all-givs}, and @samp{-frerun-loop-opt}---which
+can improve the run-time performance of some programs.
+
+@item
+Replace much of the existing documentation with a single
+Info document.
+
+@item
+New option @samp{-fno-second-underscore}.
+@end itemize
+
+@heading In 0.5.17:
+
+@itemize @bullet
+@item
+The @code{ERF()} and @code{ERFC()} intrinsics now are generic
+intrinsics, mapping to @code{ERF}/@code{DERF} and
+@code{ERFC}/@code{DERFC}, respectively.
+@emph{Note:} Use @samp{INTRINSIC ERF,ERFC} in any code that
+might reference these as generic intrinsics, to
+improve the likelihood of diagnostics (instead of subtle run-time
+bugs) when using compilers that don't support these as intrinsics.
+
+@item
+New option @samp{-Wsurprising}.
+
+@item
+DO loops with non-@code{INTEGER} variables now diagnosed only when
+@samp{-Wsurprising} specified.
+Previously, this was diagnosed @emph{unless} @samp{-fpedantic} or
+@samp{-fugly} was specified.
+@end itemize
+
+@heading In 0.5.16:
+
+@itemize @bullet
+@item
+@code{libf2c} changed to output a leading zero (0) digit for floating-point
+values output via list-directed and formatted output (to bring @code{g77}
+more into line with many existing Fortran implementations---the
+ANSI FORTRAN 77 standard leaves this choice to the implementation).
+
+@item
+@code{libf2c} no longer built with debugging information
+intact, making it much smaller.
+
+@item
+Automatic installation of the @code{g77} command now works.
+
+@item
+Diagnostic messages now more informative, a la @code{gcc},
+including messages like @samp{In function `foo':} and @samp{In file
+included from...:}.
+
+@item
+New group of intrinsics called @samp{unix}, including @code{ABORT},
+@code{DERF}, @code{DERFC}, @code{ERF}, @code{ERFC}, @code{EXIT},
+@code{FLUSH}, @code{GETARG}, @code{GETENV}, @code{SIGNAL}, and
+@code{SYSTEM}.
+
+@item
+@samp{-funix-intrinsics-@{delete,hide,disable,enable@}}
+options added.
+
+@item
+@samp{-fno-underscoring} option added.
+
+@item
+@samp{--driver} option added to the @code{g77} command.
+
+@item
+Support for the @code{gcc} options @samp{-fident} and @samp{-fno-ident}
+added.
+
+@item
+@samp{g77 -v} returns much more version info, making the submission
+of better bug reports easily.
+
+@item
+Many improvements to the @code{g77} command to better fulfill its role as
+a front-end to the @code{gcc} driver.
+For example, @code{g77} now
+recognizes @samp{--verbose} as a verbose way of specifying @samp{-v}.
+
+@item
+Compiling preprocessed (@file{*.F} and @file{*.fpp}) files now
+results in better diagnostics and debugging information, as the
+source-location info now is passed all the
+way through the compilation process instead of being lost.
+@end itemize
+
+@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 @url{http://kumo.swcp.com/fortran/F77_std/f77_std.html}
+or in @url{ftp://ftp.ast.cam.ac.uk/pub/michael/}.
+It offers some extensions that are popular among users
+of UNIX @code{f77} and @code{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
+@url{http://www.fortran.com/fortran/Books/}.)
+
+Part of what defines a particular implementation of a Fortran
+system, such as @code{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 @code{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::
+@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 @code{g77} itself is in beta test.
+Some current features of the language might later
+be redefined as dialects of Fortran supported by @code{g77}
+when better ways to express these features are added to @code{g77},
+for example.
+Such features would still be supported by
+@code{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} (@code{g77}).
+
+For example, @code{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 @code{g77} accepts
+when compiling using the prevailing defaults and what this
+document describes as being part of the language.
+
+Future versions of @code{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 @code{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 @code{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 @code{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, heteregenous 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 @code{g77} can use to resolve
+conflicts between various camps of Fortran users.
+If these two camps disagree about what a particular construct should
+mean, @code{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 @code{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 @code{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 @code{g77}).
+
+@node Standard Support
+@section ANSI FORTRAN 77 Standard Support
+@cindex ANSI FORTRAN 77 support
+@cindex standard support
+@cindex support for ANSI 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 @code{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
+
+@code{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
+
+@code{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 @code{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 @code{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, @code{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, @code{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 @code{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 @code{g77}.
+
+@item
+Bugs in the system.
+@end itemize
+
+Despite these ``loopholes'', the availability of a clear specification
+of the language of programs submitted to @code{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 @code{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.)
+
+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 comments, trailing
+@cindex trailing comments
+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 semicolons
+@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, @code{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::
+@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
+Semicolon (@samp{;})
+
+@item
+Exclamation point (@samp{!})
+
+@item
+Double quote (@samp{"})
+
+@item
+Backslash (@samp{\})
+
+@item
+Question mark (@samp{?})
+
+@item
+Hash mark (@samp{#})
+
+@item
+Ampersand (@samp{&})
+
+@item
+Percent sign (@samp{%})
+
+@item
+Underscore (@samp{_})
+
+@item
+Open angle (@samp{<})
+
+@item
+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 blanks (spaces)
+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 form
+@cindex files, 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 12 (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 blanks (spaces)
+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 lines, number of
+@cindex lines, continuation
+@cindex number of continuation lines
+@cindex limits on 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
+
+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.
+
+(@code{g77} treats it as a filename that it searches for
+in the current directory and/or directories specified
+via the @samp{-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 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
+@code{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 @code{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
+@code{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.
+@code{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 @code{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 @code{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
+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 @code{g77}---avoid writing code depending
+on them while @code{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.)
+
+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.)
+
+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 @code{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, @code{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(%LOC(I))}, and
+in fact might compile to identical code.
+
+However, @samp{CALL FOO(%LOC(I))} emphatically means ``pass the
+address of @samp{I} in memory''.
+While @samp{CALL FOO(I)} might use that same approach in a
+particular version of @code{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(%LOC(I))}
+using the same version or compiler.
+
+@xref{Debugging and Interfacing}, for detailed information on
+how this particular version of @code{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 @code{f2c}.
+
+@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 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.
+
+@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 @code{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
+
+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, @code{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 @code{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, @code{g77} passes
+all arguments
+(other than variables and arrays of type @code{CHARACTER})
+by reference.
+Future versions of, or dialects supported by, @code{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 @code{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 @code{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, @code{g77} passes
+all variables and arrays of type @code{CHARACTER}
+by descriptor.
+Future versions of, or dialects supported by, @code{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 @code{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 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 Contact via Internet email: burley@@gnu.ai.mit.edu
+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 @samp{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 @samp{JCB002}
+above will confirm that:
+
+@itemize @bullet
+@item
+Digital Semiconductor (``DEC'') Alpha OSF/1, HP-UX 10.0.1, AIX 3.2.5
+@code{f77} compilers all implement @samp{Interp 1}.
+
+@item
+IRIX 5.3 @code{f77} compiler implements @samp{Interp 2}.
+
+@item
+Solaris 2.5, SunOS 4.1.3, DECstation ULTRIX 4.3,
+and IRIX 6.1 @code{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 REAL intrinsic
+@cindex intrinsics, REAL
+@cindex AIMAG intrinsic
+@cindex intrinsics, 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 @samp{-ff90} is in effect,
+@code{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 CMPLX intrinsic
+@cindex intrinsics, 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
+@code{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 @code{f77}/@code{f2c} Intrinsics
+
+The bit-manipulation intrinsics supported by traditional
+@code{f77} and by @code{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 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 @code{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 symbolic names
+@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 underscores
+
+Underscores (@samp{_}) are accepted in symbol names after the first
+character (which must be a letter).
+
+@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
+@code{g77} supports in whole or in part.
+
+Any of the features listed below might be disallowed by
+@code{g77} unless some command-line option is specified.
+Currently, some of the features are accepted using the
+default invocation of @code{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 form
+@cindex files, 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
+(@code{f2c}, Digital (``DEC'') Fortran, and so on), though a cleaner default
+definition along with more
+flexibility offered by command-line options is likely to be offered
+in version 0.6.
+
+This section describes how @code{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 @code{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 characters
+
+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 @code{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.
+
+@code{g77} effectively
+translates tabs to the appropriate number of spaces (a la the default
+for the UNIX @code{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.
+
+Note that this default behavior probably will change for version 0.6,
+when it will presumably be available via a command-line option.
+The default as of version 0.6 is planned to be a ``pure visual''
+model, where tabs are immediately
+converted to spaces and otherwise have no effect, so the way a typical
+user sees source lines produces a consistent result no matter how the
+spacing in those source lines is actually implemented via tabs, spaces,
+and trailing tabs/spaces before newline.
+Command-line options are likely to be added to specify whether all or
+just-tabbed lines are to be extended to 132 or full input-line length,
+and perhaps even an option will be added to specify the truncated-line
+behavior to which some Digital compilers default (and which affects
+the way continued character/Hollerith constants are interpreted).
+
+@node Short Lines
+@subsection Short Lines
+@cindex short source lines
+@cindex space-padding
+@cindex spaces
+@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).
+
+@code{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 @samp{-ffixed-line-length-none}, for example.
+
+@node Long Lines
+@subsection Long Lines
+@cindex long source lines
+@cindex truncation
+@cindex lines, long
+@cindex source lines, long
+
+Source lines longer than the applicable length are truncated to that
+length.
+Currently, @code{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 @samp{-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 @code{f2c}.
+
+@node Trailing Comment
+@section Trailing Comment
+
+@code{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
+
+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, @code{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 @samp{-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: @code{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{libf2c},
+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 --
+@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 @samp{BN} and @samp{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 @samp{-fcase-strict-upper} to specify this
+combination.
+
+Number 43 is like Number 22 except all input must be lowercase.  Use
+@samp{-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 @samp{-fcase-upper} to specify this combination.
+
+Number 66 is the ``canonical'' UNIX model whereby all the source is
+translated to lowercase.
+Use @samp{-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
+@code{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 @code{g77}
+someday, and is considered a VXT Fortran feature.
+
+The @samp{-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
+
+@code{g77} treats double-quote (@samp{"})
+as beginning an octal constant of @code{INTEGER(KIND=1)} type
+when the @code{-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 @code{-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 exclamation points
+@cindex continuation character
+@cindex characters, continuation
+@cindex comment character
+@cindex characters, comment
+
+@code{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 @code{-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 @samp{-ff90} option is not specified.
+The features enabled by @samp{-ff90} are intended to be those that,
+when @samp{-ff90} is not specified, would have another
+meaning to @code{g77}---usually meaning something invalid in the
+GNU Fortran language.
+
+So, the purpose of @samp{-ff90} is not to specify whether @code{g77} is
+to gratuitously reject Fortran 90 constructs.
+The @samp{-pedantic} option specified with @samp{-fno-f90} is intended
+to do that, although its implementation is certainly incomplete at
+this point.
+
+When @samp{-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 @samp{-ff90} is specified.
+@end itemize
+
+@node Pedantic Compilation
+@section Pedantic Compilation
+@cindex pedantic compilation
+@cindex compilation, pedantic
+
+The @samp{-fpedantic} command-line option specifies that @code{g77}
+is to warn about code that is not standard-conforming.
+This is useful for finding
+some extensions @code{g77} accepts that other compilers might not accept.
+(Note that the @samp{-pedantic} and @samp{-pedantic-errors} options
+always imply @samp{-fpedantic}.)
+
+With @samp{-fno-f90} in force, ANSI FORTRAN 77 is used as the standard
+for conforming code.
+With @samp{-ff90} in force, Fortran 90 is used.
+
+The constructs for which @code{g77} issues diagnostics when @samp{-fpedantic}
+and @samp{-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 --
+@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 @samp{-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 @samp{-fpedantic} is specified along with @samp{-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 @samp{-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.
+
+@emph{Note:} The @samp{-fugly} option, which currently serves
+as shorthand to enable all of the distensions below, is likely to
+be removed in a future version of @code{g77}.
+That's because it's likely new distensions will be added that
+conflict with existing ones in terms of assigning meaning to
+a given chunk of code.
+(Also, it's pretty clear that users should not use @samp{-fugly}
+as shorthand when the next release of @code{g77} might add a
+distension to that that causes their existing code, when recompiled,
+to behave differently---perhaps even fail to compile or run
+correctly.)
+
+@menu
+* Ugly Implicit Argument Conversion::  Disabled via @samp{-fno-ugly-args}.
+* Ugly Assumed-Size Arrays::           Enabled via @samp{-fugly-assumed}.
+* Ugly Null Arguments::                Enabled via @samp{-fugly-comma}.
+* Ugly Complex Part Extraction::       Enabled via @samp{-fugly-complex}.
+* Ugly Conversion of Initializers::    Disabled via @samp{-fno-ugly-init}.
+* Ugly Integer Conversions::           Enabled via @samp{-fugly-logint}.
+* Ugly Assigned Labels::               Enabled via @samp{-fugly-assign}.
+@end menu
+
+@node Ugly Implicit Argument Conversion
+@subsection Implicit Argument Conversion
+@cindex Hollerith constants
+@cindex constants, Hollerith
+
+The @samp{-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 @samp{-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, @samp{-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 @samp{-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 @samp{-ff90} in effect, these intrinsics return
+the unconverted real and imaginary parts (respectively)
+of their argument.
+
+With @samp{-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 @samp{-fno-ugly-complex} is in effect, because the
+meaning is clear.
+
+@code{g77} enforces this restriction, unless @samp{-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 commas
+@cindex commas, trailing
+@cindex null arguments
+@cindex arguments, null
+
+The @samp{-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 a procedure other than a
+statement function, and use of an empty list of arguments 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 @samp{-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 @samp{-fugly-comma}
+in force as compared to its behavior when compiled
+with the default, @samp{-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 @samp{-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
+@samp{-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
+@samp{-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
+@samp{-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 @samp{-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 @samp{-fugly-assign} option forces @code{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, @code{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-@samp{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 @code{g77} unless @samp{-fugly-assign}
+is specified on the command-line, ensuring that the value of @code{I}
+referenced in the second line is whatever value @code{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 @samp{-fugly-assign} is specified,
+@code{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 @code{g77} actually writing valid pointers
+to these variables, however.
+While @code{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, @code{g77}, supports programs written
+in the GNU Fortran language and in some other dialects of Fortran.
+
+Some aspects of how @code{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::
+* Compiler Types::
+* Compiler Constants::
+* Compiler Intrinsics::
+@end menu
+
+@node Compiler Limits
+@section Compiler Limits
+@cindex limits, compiler
+@cindex compiler limits
+
+@code{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
+For example, some other Fortran compiler have an option
+(such as @samp{-Nl@var{x}}) to increase the limit on the
+number of continuation lines.
+Also, some Fortran compilation systems have an option
+(such as @samp{-Nx@var{x}}) to increase the limit on the
+number of external symbols.
+
+@code{g77}, @code{gcc}, and GNU @code{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
+@code{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 well be lifted in a future version.
+
+@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.)
+
+@code{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 @code{gcc} and @code{g77}.
+@code{g77} warns about such
+situations when it encounters them.)
+
+@code{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
+@code{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 @code{gcc} built in the same release as @code{g77} (and
+which was therefore used to build both the @code{g77} compiler
+components and the @code{libf2c} 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 @code{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 @code{gcc} type as @code{INTEGER(KIND=2)}.
+
+@cindex INTEGER(KIND=3) type
+@cindex types, INTEGER(KIND=3)
+@item INTEGER(KIND=3)
+Same @code{gcc} type as signed @code{char}.
+
+@cindex LOGICAL(KIND=3) type
+@cindex types, LOGICAL(KIND=3)
+@item LOGICAL(KIND=3)
+Same @code{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 @code{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 @code{gcc} type occupies @var{n} times the storage
+space of a @code{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 @code{g77}---avoid writing code depending
+on them.
+
+Other types supported by @code{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 @code{gcc} already supports, @code{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
+
+@code{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.
+
+@code{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 @code{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
+
+@code{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, @code{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 @code{g77} to pretend as though the intrinsics in
+that group do not exist at all, whereas disabling it tells @code{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
+@item badu77
+UNIX intrinsics having inappropriate forms (usually functions that
+have intended side effects).
+
+@item gnu
+Intrinsics the GNU Fortran language supports that are extensions to
+the Fortran standards (77 and 90).
+
+@item f2c
+Intrinsics supported by AT&T's @code{f2c} converter and/or @code{libf2c}.
+
+@item f90
+Fortran 90 intrinsics.
+
+@item mil
+MIL-STD 1753 intrinsics (@code{MVBITS}, @code{IAND}, @code{BTEST}, and so on).
+
+@item unix
+UNIX intrinsics (@code{IARGC}, @code{EXIT}, @code{ERF}, and so on).
+
+@item vxt
+VAX/VMS FORTRAN (current as of v4) intrinsics.
+@end table
+
+@node Other Intrinsics
+@subsection Other Intrinsics
+@cindex intrinsics, others
+@cindex other intrinsics
+
+@code{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, @code{g77} generates code that is
+object-compatible with code generated by a version of
+@code{f2c} configured (with, for example, @file{f2c.h} definitions)
+to be generally compatible with @code{g77} as built by @code{gcc}.
+(Normally, @code{f2c} will, by default, conform to the appropriate
+configuration, but it is possible that older or perhaps even newer
+versions of @code{f2c}, or versions having certain configuration changes
+to @code{f2c} internals, will produce object files that are
+incompatible with @code{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
+@code{g77} uses the same run-time library, @code{libf2c}, used by
+@code{f2c}.
+
+Other compilers might or might not generate code that
+is object-compatible with @code{libf2c} and current @code{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 @code{f2c} Compatibility
+
+Specifying @samp{-fno-f2c} allows @code{g77} to generate, in
+some cases, faster code, by not needing to allow to the possibility
+of linking with code compiled by @code{f2c}.
+
+For example, this affects how @code{REAL(KIND=1)},
+@code{COMPLEX(KIND=1)}, and @code{COMPLEX(KIND=2)} functions are called.
+With @samp{-fno-f2c}, they are
+compiled as returning the appropriate @code{gcc} type
+(@code{float}, @code{__complex__ float}, @code{__complex__ double},
+in many configurations).
+
+With @samp{-ff2c} in force, they
+are compiled differently (with perhaps slower run-time performance)
+to accommodate the restrictions inherent in @code{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 @samp{-ff2c} in force
+might produce faster code than using @samp{-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 @code{f2c} compatibility is a fairly static target to achieve,
+though not necessarily perfectly so, since, like @code{g77}, it is
+still being improved.
+However, specifying @samp{-fno-f2c} causes @code{g77}
+to generate code that will probably be incompatible with code
+generated by future versions of @code{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 @code{g77}
+or @code{f2c}, especially when using options such as @samp{-fno-f2c}.
+
+Therefore, if you are using @code{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 @code{g77},
+you might want to stick with @code{f2c} compatibility for now, and
+carefully watch for any announcements about changes to the
+@code{f2c}/@code{libf2c} interface that might affect existing programs
+(thus requiring recompilation).
+
+It is probable that a future version of @code{g77} will not,
+by default, generate object files compatible with @code{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 @code{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.
+
+@node Compilers Other Than f2c
+@section Compilers Other Than @code{f2c}
+
+On systems with Fortran compilers other than @code{f2c} and @code{g77},
+code compiled by @code{g77} is not expected to work
+well with code compiled by the native compiler.
+(This is true for @code{f2c}-compiled objects as well.)@ 
+Libraries compiled with the native compiler probably will have
+to be recompiled with @code{g77} to be used with @code{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 @code{g77} to call a procedure the linker @code{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 @code{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 @code{g77} in @code{f2c}
+compatibility mode, i.e.@ not using @samp{-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 @code{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
+@samp{-lstdc++}, @samp{-lg++} or whatever.
+If you need to use another
+driver program (or @code{ld} directly),
+you can find out what linkage
+options @code{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, @samp{f2c} from
+@url{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 @code{f2c}}.
+
+To use @code{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
+@code{f2c} program on your path.
+
+Something else that might be useful is @samp{cfortran.h} from
+@url{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 @code{f2c} mode with
+@code{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
+@code{g77} code---calling and/or being
+called from Fortran---should @samp{#include <f2c.h>} to define the C
+versions of the Fortran types.
+Don't assume Fortran @code{INTEGER} types
+correspond to C @samp{int}s, for instance; instead, declare them as
+@code{integer}, a type defined by @file{f2c.h}.
+@file{f2c.h} is installed where @code{gcc} will find it by
+default, assuming you use a copy of @code{gcc} compatible with
+@code{g77}, probably built at the same time as @code{g77}.
+
+@node f2c Skeletons and Prototypes
+@subsection Generating Skeletons and Prototypes with @code{f2c}
+
+@pindex f2c
+@cindex -fno-second-underscore
+A simple and foolproof way to write @code{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 @samp{END} statements.
+Then run @code{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 f2c conventions, such as not using @code{doublereal} as
+the return type of a @code{REAL} @code{FUNCTION}.)
+
+@pindex ftnchek
+@code{f2c} also can help with calling Fortran from C, using its
+@samp{-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 @samp{ftnchek} tool from @url{ftp://ftp.netlib.org/fortran} 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 @code{g77}) and
+C handle arrays.
+
+@node C++ Considerations
+@subsection C++ Considerations
+
+@cindex C++
+@code{f2c} can be used to generate suitable code for compilation with a
+C++ system using the @samp{-C++} option.
+The important thing about linking @code{g77}-compiled
+code with C++ is that the prototypes for the @code{g77}
+routines must specify C linkage to avoid name mangling.
+So, use an @samp{extern "C"} declaration.
+@code{f2c}'s @samp{-C++} option will take care
+of this when generating skeletons or prototype files as above, and also
+avoid clashes with C++ reserved words in addition to those in C@.
+
+@node Startup Code
+@subsection Startup Code
+
+@cindex startup code
+@cindex runtime initialization
+@cindex initialization, runtime
+Unlike with some runtime systems, it shouldn't be necessary (unless there are
+bugs) to use a Fortran main program to ensure the
+runtime---specifically the i/o system---is initialized.
+However, to use
+the @code{g77} intrinsics @code{GETARG()} and @code{IARGC()} the
+@code{main()} routine from the @file{libf2c} library must be used, either
+explicitly or implicitly by using a Fortran main program.
+This
+@code{main()} program calls @code{MAIN__()} (where the names are C-type
+@code{extern} names, i.e.@ not mangled).
+You need to provide this
+nullary procedure as the entry point for your C code if using
+@file{libf2c}'s @code{main}.
+In some cases it might be necessary to
+provide a dummy version of this to avoid linkers complaining about
+failure to resolve @code{MAIN__()} if linking against @file{libf2c} and
+not using @code{main()} from it.
+
+@include install.texi
+
+@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 @code{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 @code{g77}-compiled code generally
+requires some understanding of the way @code{g77} compiles code for
+various constructs.
+
+Similarly, using a debugger to debug @code{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
+@code{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 @code{g77}, sometimes even to using certain compiler options
+with @code{g77} (such as @samp{-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 @code{g77}.
+This information
+is provided primarily to make debugging of code generated by this
+particular release of @code{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 @code{g77} as they
+are installed, because new versions can change the behaviors
+described in this section.
+
+@menu
+* Main Program Unit::  How @code{g77} compiles a main program unit.
+* Procedures::         How @code{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 @code{g77} performs complex arithmetic.
+* Arrays::             Dealing with (possibly multi-dimensional) arrays.
+* Adjustable Arrays::  Special consideration for adjustable arrays.
+* Alternate Entry Points::  How @code{g77} implements alternate @code{ENTRY}.
+* Alternate Returns::  How @code{g77} handles alternate returns.
+* Assigned Statement Labels::  How @code{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 @code{g77} compiles a main program unit, it gives it the public
+procedure name @samp{MAIN__}.
+The @code{libf2c} 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 @samp{MAIN__}.
+
+Generally, @code{g77} and @code{libf2c} 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 @code{g77} version 0.5.16
+includes a bug fix for @code{libf2c} 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 @code{g77} (or @code{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{libf2c}, found in the source
+file @file{gcc/f/runtime/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 IARGC() intrinsic
+@cindex intrinsics, IARGC()
+@cindex GETARG() intrinsic
+@cindex intrinsics, GETARG()
+For example, @code{libf2c}'s @code{main()} sets up the information used by
+the @code{IARGC} and @code{GETARG} intrinsics.
+Bypassing @code{libf2c}'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{libf2c} 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 @samp{MAIN__}, and then run the program.
+A convenient way to do so is to add the @code{gdb} command
+
+@example
+tbreak MAIN__
+@end example
+
+@noindent
+to the file @file{.gdbinit} in the directory in which you're debugging
+(using @code{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 @samp{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, @code{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
+@code{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{gcc/f/runtime/f2c.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 @code{g77}
+does not provide the trailing null bytes on the constant
+strings (@code{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
+
+@code{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}, @code{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 @samp{-ff2c} is in
+force, @code{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 @samp{-fno-f2c} is in force,
+@code{g77} implements a @code{COMPLEX} function as @code{gcc}'s
+@samp{__complex__ float} or @samp{__complex__ double} function
+(or an emulation thereof, when @samp{-femulate-complex} is in effect),
+returning the result of the function in the same way as @code{gcc} would.
+
+For @code{REAL(KIND=1)}, when @samp{-ff2c} is in force, @code{g77} implements
+a function that actually returns @code{REAL(KIND=2)} (typically
+C's @code{double} type).
+When @samp{-fno-f2c} is in force, @code{REAL(KIND=1)}
+functions return @code{float}.
+
+@node Names
+@section Names
+@cindex symbol names
+@cindex transformation of 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 @code{g77}, to generate code that is compatible with 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 @samp{-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 @samp{-funderscoring} is in force, any name (external or local)
+that already has at least one underscore in it is
+implemented by @code{g77} by appending two underscores.
+(This second underscore can be disabled via the
+@samp{-fno-second-underscore} option.)@ 
+External names are changed this way for @code{f2c} compatibility.
+Local names are changed this way to avoid collisions with external names
+that are different in the source code---@code{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 @code{g77} in this regard in the future---don't
+write scripts depending on this behavior!
+Also, consider experimenting with the @samp{-fno-underscoring}
+option to try out debugging without having to massage names by
+hand like this.)
+
+@code{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 @code{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, @code{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 @samp{-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 COMMON statement
+@cindex statements, COMMON
+
+@code{g77} names and lays out @code{COMMON} areas the same way f2c does,
+for compatibility with f2c.
+
+Currently, @code{g77} does not emit ``true'' debugging information for
+members of a @code{COMMON} area, due to an apparent bug in the GBE.
+
+(As of Version 0.5.19, @code{g77} emits debugging information for such
+members in the form of a constant string specifying the base name of
+the aggregate area and the offset of the member in bytes from the start
+of the area.
+Use the @samp{-fdebug-kludge} option to enable this behavior.
+In @code{gdb}, use @samp{set language c} before printing the value
+of the member, then @samp{set language fortran} to restore the default
+language, since @code{gdb} doesn't provide a way to print a readable
+version of a character string in Fortran language mode.
+
+This kludge will be removed in a future version of @code{g77} that,
+in conjunction with a contemporary version of @code{gdb},
+properly supports Fortran-language debugging, including access
+to members of @code{COMMON} areas.)
+
+@xref{Code Gen Options,,Options for Code Generation Conventions},
+for information on the @samp{-fdebug-kludge} option.
+
+Moreover, @code{g77} currently implements a @code{COMMON} area such that its
+type is an array of the C @code{char} data type.
+
+So, when debugging, you must know the offset into a @code{COMMON} area
+for a particular item in that area, and you have to take into
+account the appropriate multiplier for the respective sizes
+of the types (as declared in your code) for the items preceding
+the item in question as compared to the size of the @code{char} type.
+
+For example, using default implicit typing, the statement
+
+@example
+COMMON I(15), R(20), T
+@end example
+
+@noindent
+results in a public 144-byte @code{char} array named @samp{_BLNK__}
+with @samp{I} placed at @samp{_BLNK__[0]}, @samp{R} at @samp{_BLNK__[60]},
+and @samp{T} at @samp{_BLNK__[140]}.
+(This is assuming that the target machine for
+the compilation has 4-byte @code{INTEGER(KIND=1)} and @code{REAL(KIND=1)}
+types.)
+
+@node Local Equivalence Areas
+@section Local Equivalence Areas (EQUIVALENCE)
+@cindex equivalence areas
+@cindex local equivalence areas
+@cindex EQUIVALENCE statement
+@cindex statements, EQUIVALENCE
+
+@code{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.
+
+Currently, @code{g77} does not emit ``true'' debugging information for
+members in a local @code{EQUIVALENCE} area, due to an apparent bug in the GBE.
+
+(As of Version 0.5.19, @code{g77} does emit debugging information for such
+members in the form of a constant string specifying the base name of
+the aggregate area and the offset of the member in bytes from the start
+of the area.
+Use the @samp{-fdebug-kludge} option to enable this behavior.
+In @code{gdb}, use @samp{set language c} before printing the value
+of the member, then @samp{set language fortran} to restore the default
+language, since @code{gdb} doesn't provide a way to print a readable
+version of a character string in Fortran language mode.
+
+This kludge will be removed in a future version of @code{g77} that,
+in conjunction with a contemporary version of @code{gdb},
+properly supports Fortran-language debugging, including access
+to members of @code{EQUIVALENCE} areas.)
+
+@xref{Code Gen Options,,Options for Code Generation Conventions},
+for information on the @samp{-fdebug-kludge} option.
+
+Moreover, @code{g77} implements a local @code{EQUIVALENCE} area such that its
+type is an array of the C @code{char} data type.
+
+The name @code{g77} gives this array of @code{char} type is @samp{__g77_equiv_@var{x}},
+where @var{x} is the name of the item that is placed at the beginning (offset 0)
+of this array.
+If more than one such item is placed at the beginning, @var{x} is
+the name that sorts to the top in an alphabetical sort of the list of
+such items.
+
+When debugging, you must therefore access members of @code{EQUIVALENCE}
+areas by specifying the appropriate @samp{__g77_equiv_@var{x}}
+array section with the appropriate offset.
+See the explanation of debugging @code{COMMON} blocks
+for info applicable to debugging local @code{EQUIVALENCE} areas.
+
+(@emph{Note:} @code{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}, @code{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 of complex
+@cindex COMPLEX statement
+@cindex statements, COMPLEX
+
+As of 0.5.20, @code{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, @code{g77} implements these types using an
+internal construct similar to C's @code{struct}, at least
+as seen by the @code{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
+@code{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 @code{gdb}, this is accomplished via @samp{set lang c} and
+either @samp{set lang fortran} or @samp{set lang auto}.)
+
+@emph{Note:} Compiling with the @samp{-fno-emulate-complex} option
+avoids the debugging problem, but is known to cause other problems
+like compiler crashes and generation of incorrect code, so it is
+not recommended.
+
+@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 @code{f2c}, @code{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
+non-zero 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 @code{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, @code{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 @code{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 @code{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 @code{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.
+@code{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 @code{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 @code{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.
+
+@code{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, @code{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 @code{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 @samp{-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 @code{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 @code{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 @code{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 @code{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)}, @code{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 @code{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; @code{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.
+@code{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 @code{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 @code{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 @code{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{libf2c} 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 @samp{F_err} in @file{f/runtime/libI77/err.c} in the
+@code{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 @code{g77} can be divided into two camps:
+
+@itemize @bullet
+@item
+Those writing new Fortran code to be compiled by @code{g77}.
+
+@item
+Those using @code{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 @code{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 @code{f2c} is so great, why @code{g77}?
+* Block Data and Libraries::   How @code{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 @code{f2c}, @code{g77} would have taken much longer to
+do and probably not been as good for quite a while.
+Sometimes people who notice how much @code{g77} depends on, and
+documents encouragement to use, @code{f2c} ask why @code{g77}
+was created if @code{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.
+* Compiler Options::     Features helpful during development.
+* 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
+
+@code{g77} offers several extensions to the Fortran language that @code{f2c}
+doesn't.
+
+However, @code{f2c} offers a few that @code{g77} doesn't, like
+fairly complete support for @code{INTEGER*2}.
+It is expected that @code{g77} will offer some or all of these missing
+features at some time in the future.
+(Version 0.5.18 of @code{g77} offers some rudimentary support for some
+of these features.)
+
+@node Compiler Options
+@subsection Compiler Options
+
+@code{g77} offers a whole bunch of compiler options that @code{f2c} doesn't.
+
+However, @code{f2c} offers a few that @code{g77} doesn't, like an
+option to generate code to check array subscripts at run time.
+It is expected that @code{g77} will offer some or all of these
+missing options 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 @code{g77} should be able to compile code much faster than using
+@code{f2c} in conjunction with the equivalent invocation of @code{gcc}.
+
+However, due to @code{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, @code{g77}
+is noticeably faster compiling many Fortran source files than using
+@code{f2c} in conjunction with @code{gcc}.
+
+@node Program Speed
+@subsection Program Speed
+
+@code{g77} has the potential to better optimize code than @code{f2c},
+even when @code{gcc} is used to compile the output of @code{f2c},
+because @code{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 @code{g77} can gather, preserve, and transmit that information directly
+to the GBE.
+
+For example, @code{g77} implements @code{ASSIGN} and assigned
+@code{GOTO} using direct assignment of pointers to labels and direct
+jumps to labels, whereas @code{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 @code{f2c} plus @code{gcc}
+can generate code that is faster than @code{g77}.
+
+Version 0.5.18 of @code{g77} offered default
+settings and options, via patches to the @code{gcc}
+back end, that allow for better program speed, though
+some of these improvements also affected the performance
+of programs translated by @code{f2c} and then compiled
+by @code{g77}'s version of @code{gcc}.
+
+Version 0.5.20 of @code{g77} offers further performance
+improvements, at least one of which (alias analysis) is
+not generally applicable to @code{f2c} (though @code{f2c}
+could presumably be changed to also take advantage of
+this new capability of the @code{gcc} back end, assuming
+this is made available in an upcoming release of @code{gcc}).
+
+@node Ease of Debugging
+@subsection Ease of Debugging
+
+Because @code{g77} compiles directly to assembler code like @code{gcc},
+instead of translating to an intermediate language (C) as does @code{f2c},
+support for debugging can be better for @code{g77} than @code{f2c}.
+
+However, although @code{g77} might be somewhat more ``native'' in terms of
+debugging support than @code{f2c} plus @code{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, @code{g77} doesn't have to worry about reserved names
+like @code{f2c} does.
+Given @samp{FOR = WHILE}, @code{f2c} must necessarily
+translate this to something @emph{other} than
+@samp{for = while;}, because C reserves those words.
+
+However, @code{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 @code{g77} user should be able to access the variables directly, by name,
+without having to traverse C-like structures and unions, while @code{f2c}
+is unlikely to ever offer this ability (due to limitations in the
+C language).
+
+However, due to apparent bugs in the back end, @code{g77} currently doesn't
+take advantage of this facility at all---it doesn't emit any debugging
+information for @code{COMMON} and @code{EQUIVALENCE} areas,
+other than information
+on the array of @code{char} it creates (and, in the case
+of local @code{EQUIVALENCE}, names) for each such area.
+
+Yet another example is arrays.
+@code{g77} represents them to the debugger
+using the same ``dimensionality'' as in the source code, while @code{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 @code{g77} can vary widely.
+In some cases, it can actually
+be an advantage that @code{f2c} converts everything to widely supported
+C semantics.
+
+In fairness, @code{g77} could do many of the things @code{f2c} does
+to get things working at least as well as @code{f2c}---for now,
+the developers prefer making @code{g77} work the
+way they think it is supposed to, and finding help improving the
+other products (the back end of @code{gcc}; @code{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,
+@code{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.
+
+@code{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 @code{g77} simply asks for fewer zeros from the operating
+system than @code{f2c}.
+
+@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 @code{f2c} compatibility
+@cindex compatibility, @code{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}.
+@code{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, @code{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, @code{g77} outputs in the data section a static pointer to the
+external name @samp{FOO}.)
+
+The implementation @code{g77} currently uses to make this work is
+one of the few things not compatible with @code{f2c} as currently
+shipped.
+@code{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}, f2c doesn't generate a dummy procedure with the
+name @samp{FOO}.
+The upshot is that you shouldn't mix @code{f2c} and @code{g77} in
+this particular case.
+If you use f2c to compile @samp{BLOCK DATA FOO},
+then any @code{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 @code{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 @code{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 @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 @code{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 @code{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 @code{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 @code{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, @code{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 @code{g77}, use of @code{DO} loops
+with @code{REAL} iteration
+variables is not recommended.
+Such use can be caught by specifying @samp{-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.
+
+@code{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::
+@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 @samp{-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.
+(@code{g77} supports @code{IMPLICIT NONE}, as do almost all
+FORTRAN 77 compilers.)
+
+Note that @samp{-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 @code{g77} for this behavior by specifying the
+@samp{-finit-local-zero} option when compiling Fortran code.
+(You might want to specify @samp{-fno-automatic} as well,
+to avoid code-size inflation for non-optimized compilations.)
+
+Note that a program that works better when compiled with the
+@samp{-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 @samp{-O -Wuninitialized}
+options using @code{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 @code{g77} to assume @code{SAVE} is specified for all
+relevant (local) variables and arrays by using the
+@samp{-fno-automatic} option.
+
+Note that a program that works better when compiled with the
+@samp{-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 @code{g77}.
+
+@node Unwanted Variables
+@subsection Unwanted Variables
+
+The @samp{-Wunused} option can find bugs involving
+implicit typing, sometimes
+more easily than using @samp{-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 @samp{-W} also enables warnings regarding overflow
+of floating-point constants under certain circumstances.
+
+@node Surprising Interpretations of Code
+@subsection Surprising Interpretations of Code
+
+The @samp{-Wsuprising} 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 @code{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 @code{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 @samp{-falias-check}, @samp{-fargument-alias},
+@samp{-fargument-noalias},
+and @samp{-fno-argument-noalias-global} options,
+introduced in version 0.5.20 and
+@code{g77}'s version 2.7.2.2.f.2 of @code{gcc},
+control the assumptions regarding aliasing
+(overlapping)
+of writes and reads to main memory (core) made
+by the @code{gcc} back end.
+
+They are effective only when compiling with @samp{-O} (specifying
+any level other than @samp{-O0}) or with @samp{-falias-check}.
+
+The default for Fortran code is @samp{-fargument-noalias-global}.
+(The default for C code and code written in other C-based languages
+is @samp{-fargument-alias}.
+These defaults apply regardless of whether you use @code{g77} or
+@code{gcc} to compile your code.)
+
+Note that, on some systems, compiling with @samp{-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
+assocation'', appears in Sections 15.9.3.6.
+This prohibition allows implementations, such as @code{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 @samp{-fargument-alias} option, which causes the
+compiler to revert to assumptions essentially the same as
+made by versions of @code{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 @code{g77}
+in a way that results in a faster executable.
+
+(You might want to try compiling with @samp{-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, @code{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 @code{g77}, though patches improving @code{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, @code{g77} configured its
+version of the @code{libf2c} run-time library so that one of
+its configuration macros, @samp{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, @code{g77} no longer configures @code{libf2c}
+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{libf2c}, rebuild and reinstall @code{g77}, and
+relink your programs with the modified library.
+
+(Ideally, @code{libf2c} would offer the choice at run-time, so
+that a compile-time option to @code{g77} or @code{f2c} could
+result in generating the appropriate calls to flushing or
+non-flushing library routines.)
+
+@xref{Always Flush Output}, for information on how to modify
+the @code{g77} source tree so that a version of @code{libf2c}
+can be built and installed with the @samp{ALWAYS_FLUSH} macro defined.
+
+@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{libf2c}, used, and
+distributed with, @code{g77}.
+
+The message means that your program has attempted to use a
+file unit number that is out of the range accepted by
+@code{libf2c}.
+Normally, this range is 0 through 99, and the high end
+of the range is controlled by a @code{libf2c} source-file
+macro named @samp{MXUNIT}.
+
+If you can easily change your program to use unit numbers
+in the range 0 through 99, you should do so.
+
+Otherwise, see @ref{Larger File Unit Numbers}, for information on how
+to change @samp{MXUNIT} in @code{libf2c} so you can build and
+install a new version of @code{libf2c} that supports the larger
+unit numbers you need.
+
+@emph{Note:} While @code{libf2c} 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.
+
+@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
+@samp{-finit-local-zero} is not needed.
+
+Consider using @samp{-Wuninitialized} (which requires @samp{-O}) to
+find likely candidates, but
+do not specify @samp{-finit-local-zero} or @samp{-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 @samp{-Wuninitialized} (which requires @samp{-O})
+to find likely candidates, but
+do not specify @samp{-finit-local-zero} or @samp{-fno-automatic},
+or this technique won't work.
+
+The default is @samp{-fautomatic}, which tells @code{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, @code{g77} supports only automatic arrays, not
+@code{RECURSIVE} procedures or other means of explicitly
+specifying that variables or arrays are automatic.
+
+@cindex -fugly option
+@cindex options, -fugly
+@item -fugly
+Fix the source code so that @samp{-fno-ugly} will work.
+Note that, for many programs, it is difficult to practically
+avoid using the features enabled via @samp{-fugly-init}, and these
+features pose the lowest risk of writing nonportable code, among the
+various ``ugly'' features.
+
+@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 @samp{-f@var{group}-intrinsics-disable}.
+@end table
+
+@node Faster Programs
+@section Faster Programs
+@cindex speeding up programs
+@cindex programs, speeding up
+
+Aside from the usual @code{gcc} options, such as @samp{-O},
+@samp{-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 data, aligned
+@cindex stack, aligned
+@cindex aligned data
+@cindex aligned stack
+@cindex Pentium optimizations
+@cindex optimizations, 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.
+
+There are a variety of approaches to use to address this problem,
+in any combination:
+
+@itemize @bullet
+@item
+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.
+
+@item
+Use the (x86-specific) @samp{-malign-double} option when compiling
+programs.
+This will align only static data (entities in @code{COMMON} or
+local entities with the @code{SAVE} attribute),
+but it should probably always be
+used with Fortran code on the 586 and 686 architectures for best
+performance.
+
+This feature of @samp{-malign-double} means it may actually be best to
+use it with @samp{-fno-automatic} even though the latter usually
+produces worse code; at least, doing so will tend to produce more
+consistent run times.
+
+Using @samp{-malign-double} and @samp{-fno-automatic} together is
+apparently the only way to ensure that all doubles are correctly aligned
+on GNU x86 systems without having to change @code{g77} itself as
+described in the next item.
+(Note that the @code{gcc} C extension @samp{__attribute__ ((aligned (8))}
+also won't double-align the datum to which it is applied if that is allocated
+on the stack.)
+It isn't clear whether this deficiency also applies to
+non-GNU based x86 systems (Solaris, DGUX et al), but it probably does.
+
+@item
+Change the definition of the @samp{STACK_BOUNDARY} macro in
+@file{gcc/config/i386/i386.h} from @samp{32} to
+@samp{(TARGET_ALIGN_DOUBLE ? 64 : 32)}, and rebuild
+@code{g77}.
+@xref{Installation,,Installing GNU Fortran}, for more information.
+
+@item
+Ensure that @file{crt0.o} or @file{crt1.o}
+on your system guarantees a 64-bit
+aligned stack for @code{main()}.
+Some experimentation might be needed to determine this, and
+access to source code to fix this.
+While arranging this may typically
+get more data properly aligned, it won't, by itself,
+ensure they all are.
+
+One approach to testing this is to write a @code{main()} program
+in C or assembler that outputs the address of the stack pointer
+(and/or frame pointer), and visually inspect the output to see
+if the stack is 64-bit aligned.
+If it is, try renaming the executable to longer and shorter names
+and running the program again.
+If the name of the executable is placed on the stack by @file{crt0.o}
+or @file{crt1.o},
+the location of the stack should move, and this might help determine
+whether it is kept on a 64-bit boundary.
+@end itemize
+
+Yes, this is all more complicated than it should be.
+The problems are best solved in @code{gcc} and the
+libraries for the operating systems on such systems,
+which need to be continuously updated to provide the
+best alignment for newly released processors.
+Managing this while remaining compatible with ABIs
+on various systems can be challenging.
+
+@node Prefer Automatic Uninitialized Variables
+@subsection Prefer Automatic Uninitialized Variables
+
+If you're using @samp{-fno-automatic} already, you probably
+should change your code to allow compilation with @samp{-fautomatic}
+(the default), to allow the program to run faster.
+
+Similarly, you should be able to use @samp{-fno-init-local-zero}
+(the default) instead of @samp{-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, @samp{-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, @samp{-fno-init-local-zero} forces such
+variables to be initialized to zero---when @code{SAVE}d (such as when
+@samp{-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 @samp{-fno-automatic} and
+@samp{-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 @code{f2c} compatibility
+@cindex compatibility, @code{f2c}
+
+If you aren't linking with any code compiled using
+@code{f2c}, try using the @samp{-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 @code{f2c}---it is compiled by a C
+compiler, typically @code{gcc}.)
+
+@node Use Submodel Options
+@subsection Use Submodel Options
+@cindex Pentium optimizations
+@cindex optimizations, Pentium
+@cindex 586/686 CPUs
+@cindex submodels
+
+Using an appropriate @samp{-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 and
+Porting GNU CC}.
+
+For recent CPUs that don't have explicit support in
+the released version of @code{gcc}, it may still be possible to get
+improvements.
+For instance, the flags recommended for 586/686
+(Pentium(Pro)) chips for building the Linux kernel are:
+
+@smallexample
+-m486 -malign-loops=2 -malign-jumps=2 -malign-functions=2
+-fomit-frame-pointer
+@end smallexample
+
+@noindent @samp{-fomit-frame-pointer} will, however, inhibit debugging
+on x86 systems.
+
+@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.
+
+Information on bugs that show up when configuring, porting, building,
+or installing @code{g77} is not provided here.
+@xref{Problems Installing}.
+
+To find out about major bugs discovered in the current release and
+possible workarounds for them, retrieve
+@url{ftp://alpha.gnu.ai.mit.edu/g77.plan}.
+
+(Note that some of this portion of the manual is lifted
+directly from the @code{gcc} manual, with minor modifications
+to tailor it to users of @code{g77}.
+Anytime a bug seems to have more to do with the @code{gcc}
+portion of @code{g77},
+@xref{Trouble,,Known Causes of Trouble with GNU CC,
+gcc,Using and Porting GNU CC}.)
+
+@menu
+* But-bugs::         Bugs really in other programs or elsewhere.
+* Actual Bugs::      Bugs and misfeatures we will fix later.
+* 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 @code{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 @code{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 @code{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 @code{g77} maintainers have their hands full working on
+just fixing and improving @code{g77}, without serving as a
+clearinghouse for all bugs that happen to affect @code{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 @code{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 @url{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 ld error for user code
+@cindex ld can't find strange names
+On some systems, perhaps just those with out-of-date (shared?)
+libraries, unresolved-reference errors happen when linking @code{g77}-compiled
+programs (which should be done using @code{g77}).
+
+If this happens to you, try appending @samp{-lc} to the command you
+use to link the program, e.g. @samp{g77 foo.f -lc}.
+@code{g77} already specifies @samp{-lf2c -lm} when it calls the linker,
+but it cannot also specify @samp{-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{-lf2c -lm} is insufficient to resolve code produced
+by @code{g77}.
+
+@cindex undefined reference (_main)
+@cindex linking error for user code
+@cindex ld error for user code
+@cindex code, user
+@cindex ld can't find _main
+If your program doesn't link due to unresolved references to names
+like @samp{_main}, make sure you're using the @code{g77} command to do the
+link, since this command ensures that the necessary libraries are
+loaded by specifying @samp{-lf2c -lm} when it invokes the @code{gcc}
+command to do the actual link.
+(Use the @samp{-v} option to discover
+more about what actually happens when you use the @code{g77} and @code{gcc}
+commands.)
+
+Also, try specifying @samp{-lc} as the last item on the @code{g77}
+command line, in case that helps.
+
+@node Large Common Blocks
+@subsection Large Common Blocks
+@cindex common blocks, large
+@cindex large common blocks
+@cindex linker errors
+@cindex 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 @code{ld}, fixed in
+more recent versions of @code{binutils}, such as version 2.6.
+
+@node Debugger Problems
+@subsection Debugger Problems
+@cindex @code{gdb} support
+@cindex support, @code{gdb}
+There are some known problems when using @code{gdb} on code
+compiled by @code{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.
+
+@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 @code{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{gcc/f/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
+@code{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 @code{csh} and derivatives) or
+@kbd{ulimit -s} (in @code{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
+@samp{-fno-automatic} option to reduce stack usage, probably at the
+expense of speed.
+
+@xref{Maximum Stackable Size}, for information on patching
+@code{g77} to use different criteria for placing local
+non-automatic variables and arrays on the stack.
+
+@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 @samp{-fno-automatic},
+nor changing the cut-off point for @code{g77} for using the stack,
+will solve the problem by changing the placement of these
+large arrays, as they are @emph{necessarily} automatic.
+
+@code{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 @samp{test}
+@cindex @samp{test} programs
+@cindex programs named @samp{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 @samp{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 @code{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
+@code{man}, @code{info} (on GNU systems), @code{setenv} (or
+@code{set} and @code{env}), @code{which}, and @code{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
+@code{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.
+
+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).
+
+Plans call for improving @code{g77} so that it can offer 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 an array, or checking for agreement between
+calling and called procedures.
+
+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 spaces, 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 behaviour.
+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 @code{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 @code{g77},
+use binary arithmetic to represent these approximations.
+
+Therefore, the exact value of any floating-point approximation
+as manipulated by @code{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 denomenator 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 @code{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{libf2c} library,
+used by @code{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 _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 @code{g77} and/or @code{libf2c} 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.
+
+@include bugs.texi
+
+@node Missing Features
+@section Missing Features
+
+This section lists features we know are missing from @code{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::
+* 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::
+* 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::
+* Suppressing Space Padding::
+* Fortran Preprocessor::
+* Bit Operations on Floating-point Data::
+
+New facilities:
+* POSIX Standard::
+* Floating-point Exception Handling::
+* Nonportable Conversions::
+* Large Automatic Arrays::
+* Support for Threads::
+* Increasing Precision/Range::
+
+Better diagnostics:
+* 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::
+* Bounds Checking at Run Time::
+
+Debugging:
+* Labels Visible to Debugger::
+@end menu
+
+@node Better Source Model
+@subsection Better Source Model
+
+@code{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, @code{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, @code{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 @code{-Wno-col73to80} option.
+
+@node Fortran 90 Support
+@subsection Fortran 90 Support
+@cindex Fortran 90 support
+@cindex support, Fortran 90
+
+@code{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 @code{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 @code{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
+
+@code{g77} doesn't allow intrinsics in @code{PARAMETER} statements.
+This feature is considered to be absolutely vital, even though it
+is not standard-conforming, and is scheduled for version 0.6.
+
+Related to this, @code{g77} doesn't allow non-integral
+exponentiation in @code{PARAMETER} statements, such as
+@samp{PARAMETER (R=2**.25)}.
+It is unlikely @code{g77} will ever support this feature,
+as doing it properly requires complete emulation of
+a target computer's floating-point facilities when
+building @code{g77} as a cross-compiler.
+But, if the @code{gcc} back end is enhanced to provide
+such a facility, @code{g77} will likely use that facility
+in implementing this feature soon afterwards.
+
+@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
+
+@code{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 -i8
+@cindex f2c
+@cindex increasing precision
+@cindex precision, increasing
+@cindex increasing range
+@cindex range, increasing
+@cindex Toolpack
+@cindex Netlib
+
+Some compilers, such as @code{f2c}, have an option (@samp{-r8} 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 (@samp{-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.)
+
+@code{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 @code{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 INTEGER*2 support
+@cindex LOGICAL*1 support
+
+@code{g77} doesn't fully support @code{INTEGER*2}, @code{LOGICAL*1},
+and similar.
+Version 0.6 will provide full support for this very
+popular set of features.
+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 REAL*16 support
+@code{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.
+This is scheduled for version 0.6.
+
+@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 DIMENSION statement
+@cindex statements, DIMENSION
+
+@code{g77} doesn't support more general expressions to dimension
+arrays, such as array element references, function
+references, etc.
+
+For example, @code{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
+
+@code{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 @code{g77}.
+
+@node Sensible Non-standard Constructs
+@subsection Sensible Non-standard Constructs
+
+@code{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 @code{g77} (though @samp{-fpedantic} should
+trigger warnings about such non-standard constructs).
+
+Until @code{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, @code{g77} already has been changed to
+allow this combination, because although the general
+problem of gratuitously rejecting unambiguous and
+``safe'' constructs still exists in @code{g77}, this
+particular construct was deemed useful enough that
+it was worth fixing @code{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 @code{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 @code{g77} just for cases like yours.
+
+@node FLUSH Statement
+@subsection @code{FLUSH} Statement
+
+@code{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
+
+@code{g77} doesn't support @samp{FORMAT(I<J>)} and the like.
+Supporting this requires a significant redesign or replacement
+of @code{libf2c}.
+
+However, a future version of @code{g77} might support
+this construct when the expression is constant.  For
+example:
+
+@smallexample
+      PARAMETER (IWIDTH = 12)
+10    FORMAT (I<IWIDTH>)
+@end smallexample
+
+In the meantime, 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
+
+@code{g77} needs to provide some way, a la @code{gcc}, for @code{g77}
+code to specify explicit assembler code.
+
+@node Q Edit Descriptor
+@subsection Q Edit Descriptor
+@cindex FORMAT statement
+@cindex Q edit descriptor
+
+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{libf2c}.
+
+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
+
+@code{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
+
+@code{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
+
+@code{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 @code{g77}, partly
+because it requires a great deal of work either upgrading or
+replacing @code{libf2c}.
+
+@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
+
+@code{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 @code{g77} itself, but
+require much more work on @code{libf2c}.
+
+@node ENCODE and DECODE
+@subsection @code{ENCODE} and @code{DECODE}
+@cindex ENCODE statement
+@cindex statements, ENCODE
+@cindex DECODE statement
+@cindex statements, DECODE
+
+@code{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 @code{g77}.
+
+@node Suppressing Space Padding
+@subsection Suppressing Space Padding of Source Lines
+
+@code{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
+@code{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.
+@code{g77} should return the favor by offering conformance
+to Digital's approach to handling the above example.
+
+@node Fortran Preprocessor
+@subsection Fortran Preprocessor
+
+@code{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 AND intrinsic
+@cindex intrinsics, AND
+@cindex OR intrinsic
+@cindex intrinsics, OR
+@cindex SHIFT intrinsic
+@cindex intrinsics, SHIFT
+
+@code{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 @code{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 POSIX Standard
+@subsection @code{POSIX} Standard
+
+@code{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 @code{gcc} backend and, consequently, @code{g77}, currently provides no
+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 behaviour is inherited from the system-dependent startup code.
+
+Most systems provide some C-callable mechanism to change this; this can
+be invoked at startup using @code{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 an x86-based GNU system:
+
+@smallexample
+#include <fpu_control.h>
+void __attribute__ ((constructor))
+trapfpe () @{
+  (void) __setfpucw (_FPU_DEFAULT &
+                     ~(_FPU_MASK_IM | _FPU_MASK_ZM | _FPU_MASK_OM));
+@}
+@end smallexample
+
+@node Nonportable Conversions
+@subsection Nonportable Conversions
+@cindex nonportable conversions
+@cindex conversions, nonportable
+
+@code{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 @code{g77}
+when the @samp{-fugly} 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,
+@code{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 @code{g77} nor the @code{libf2c} library
+are thread-safe, nor does @code{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 Gracefully Handle Sensible Bad Code
+@subsection Gracefully Handle Sensible Bad Code
+
+@code{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 @samp{-ff2c-intrinsics-disable},
+@code{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
+
+@samp{-Wconversion} and related should flag places where non-standard
+conversions are found.
+Perhaps much of this would be part of @samp{-Wugly*}.
+
+@node Non-standard Intrinsics
+@subsection Non-standard Intrinsics
+
+@code{g77} needs a new option, like @samp{-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
+
+@code{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 @code{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
+
+@code{g77} needs to support @samp{-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
+
+@code{g77} needs a @samp{-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
+
+@code{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
+
+@code{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, @code{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, @code{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
+
+@code{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
+
+@code{g77} needs a set of options such as @samp{-Wugly*}, @samp{-Wautomatic},
+@samp{-Wvxt}, @samp{-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
+
+@code{g77} should warn about unused labels when @samp{-Wunused} is in effect.
+
+@node Informational Messages
+@subsection Informational Messages
+
+@code{g77} needs an option to suppress information messages (notes).
+@samp{-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
+
+@code{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 Bounds Checking at Run Time
+@subsection Bounds Checking at Run Time
+
+@code{g77} should offer run-time bounds-checking of array/subscript references
+in a fashion similar to @code{f2c}.
+
+Note that @code{g77} already warns about references to out-of-bounds
+elements of arrays when it detects these at compile time.
+
+@node Labels Visible to Debugger
+@subsection Labels Visible to Debugger
+
+@code{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 underscores
+
+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 COMMON statement
+@cindex statements, COMMON
+@cindex naming conflicts
+
+@code{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 @code{g77} does not,
+to be compatible with @code{f2c}.
+
+@code{g77} could special-case the way it handles
+@code{BLOCK DATA}, since it is not compatible with @code{f2c} in this
+particular area (necessarily, since @code{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 @code{g77} would treat these references as requests to
+force-load BLOCK DATA program units.
+
+In that case, if @code{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,
+@code{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*(*)
+
+@code{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 f77 support
+@cindex support, f77
+
+In the opinion of many experienced Fortran users,
+@samp{-fno-backslash} should be the default, not @samp{-fbackslash},
+as currently set by @code{g77}.
+
+First of all, you can always specify
+@samp{-fno-backslash} to turn off this processing.
+
+Despite not being within the spirit (though apparently within the
+letter) of the ANSI FORTRAN 77 standard, @code{g77} defaults to
+@samp{-fbackslash} because that is what most UNIX @code{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 @samp{-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 @samp{-fno-backslash} the default for GNU
+Fortran and thus require users of UNIX @code{f77} and @code{f2c}
+to specify @samp{-fbackslash} to get the UNIX behavior.
+
+However, the realization that @code{g77} is intended as
+a replacement for @emph{UNIX} @code{f77}, caused the author
+to choose to make @code{g77} as compatible with
+@code{f77} as feasible, which meant making @samp{-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 @code{f77} to do, by default?''
+Although at least one UNIX @code{f77} does not provide
+@samp{-fbackslash} as a default, it appears that
+the majority of them do, which suggests that
+the majority of code that is compiled by UNIX @code{f77}
+compilers expects @samp{-fbackslash} to be the default.
+
+It is probably the case that more code exists
+that would @emph{not} work with @samp{-fbackslash}
+in force than code that requires it be in force.
+
+However, most of @emph{that} code is not being compiled
+with @code{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
+@code{g77}'s default of @samp{-fbackslash} than would
+exist for the majority of UNIX @code{f77} users who
+would have to modify existing, working build procedures
+to explicitly specify @samp{-fbackslash} if that was
+not the default.
+
+One suggestion has been to configure the default for
+@samp{-fbackslash} (and perhaps other options as well)
+based on the configuration of @code{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 @code{gcc}.
+To change them for @code{g77}, you must first change them
+for @code{gcc}.
+Do not ask the maintainers of @code{g77} to do this for you,
+or to disassociate @code{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
+
+@code{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, @code{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} @code{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
+@code{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
+
+@code{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 @code{g77} as
+an invalid reference to the @code{SQRT} intrinsic function,
+because the reference is a subroutine invocation.
+
+First, @code{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, @code{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, @code{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, @code{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, @code{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, @code{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
+
+@code{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
+@code{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 @code{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 @code{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.
+@code{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
+@code{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 @samp{-fugly}, 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.
+@code{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!)
+
+@node Order of Side Effects
+@subsection Order of Side Effects
+@cindex side effects, order of evaluation
+@cindex order of evaluation, side effects
+
+@code{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 @code{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
+@samp{-W} options (for instance, @samp{-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 @code{g77} diagnostics.
+Probably, as of version 0.6, @code{g77} will
+no longer print the text of the source line, instead printing
+the column number following the file name and line number in
+a form that GNU Emacs recognizes.
+This change is expected to speed up and reduce the memory usage
+of the @code{g77} compiler.
+@c
+@c Say this when it is true -- hopefully 0.6, maybe 0.7 or later.  --burley
+@c
+@c GNU Fortran always tries to compile your program if possible; it never
+@c gratuitously rejects a program whose meaning is clear merely because
+@c (for instance) it fails to conform to a standard.  In some cases,
+@c however, the Fortran standard specifies that certain extensions are
+@c forbidden, and a diagnostic @emph{must} be issued by a conforming
+@c compiler.  The @samp{-pedantic} option tells GNU Fortran to issue warnings
+@c in such cases; @samp{-pedantic-errors} says to make them errors instead.
+@c This does not mean that @emph{all} non-ANSI constructs get warnings
+@c or errors.
+
+@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
+How do system administrators and users manage multiple incompatible
+Fortran compilers on their systems?
+How can @code{g77} contribute to this, or at least avoiding
+intefering with it?
+
+Currently, @code{g77} provides rudimentary ways to choose whether to
+overwrite portions of other Fortran compilation systems
+(such as the @code{f77} command and the @code{libf2c} library).
+Is this sufficient?
+What happens when users choose not to overwrite these---does
+@code{g77} work properly in all such installations, picking
+up its own versions, or does it pick up the existing ``alien''
+versions it didn't overwrite with its own, possibly leading
+to subtle bugs?
+
+@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.
+
+Reporting a bug might help you by bringing a solution to your problem, or
+it might not.
+(If it does not, look in the service directory; see
+@ref{Service}.)@ 
+In any case, the principal function of a bug report is
+to help the entire community by making the next version of GNU Fortran work
+better.
+Bug reports are your contribution to the maintenance of GNU Fortran.
+
+Since the maintainers are very overloaded, we cannot respond to every
+bug report.
+However, if the bug has not been fixed, we are likely to
+send you a patch and ask you to tell us whether it works. 
+
+In order for a bug report to serve its purpose, you must include the
+information that makes for fixing the bug.
+
+@menu
+* Criteria: Bug Criteria.    Have you really found a bug?
+* Where: Bug Lists.          Where to send your bug report.
+* Reporting: Bug Reporting.  How to report a bug effectively.
+* Patches: Sending Patches.  How to send a patch for GNU Fortran.
+@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
+
+@node Bug Lists
+@section Where to Report Bugs
+@cindex bug report mailing lists
+@kindex fortran@@gnu.ai.mit.edu
+Send bug reports for GNU Fortran to @email{fortran@@gnu.ai.mit.edu}.
+
+Often people think of posting bug reports to a newsgroup instead of
+mailing them.
+This sometimes appears to work, but it has one problem which can be
+crucial: a newsgroup posting does not contain a mail path back to the
+sender.
+Thus, if maintainers need more information, they might be unable
+to reach you.  For this reason, you should always send bug reports by
+mail to the proper mailing list.
+
+As a last resort, send bug reports on paper to:
+
+@example
+GNU Compiler Bugs
+Free Software Foundation
+59 Temple Place - Suite 330
+Boston, MA 02111-1307, USA
+@end example
+
+@node Bug Reporting
+@section How to Report Bugs
+@cindex compiler bugs, reporting
+
+The fundamental principle of reporting bugs usefully is this:
+@strong{report all the facts}.
+If you are not sure whether to state a
+fact or leave it out, state it!
+
+Often people omit facts because they think they know what causes the
+problem and they conclude that some details don't matter.
+Thus, you might
+assume that the name of the variable you use in an example does not matter.
+Well, probably it doesn't, but one cannot be sure.
+Perhaps the bug is a
+stray memory reference which happens to fetch from the location where that
+name is stored in memory; perhaps, if the name were different, the contents
+of that location would fool the compiler into doing the right thing despite
+the bug.
+Play it safe and give a specific, complete example.
+That is the
+easiest thing for you to do, and the most helpful.
+
+Keep in mind that the purpose of a bug report is to enable someone to
+fix the bug if it is not known.
+It isn't very important what happens if
+the bug is already known.
+Therefore, always write your bug reports on
+the assumption that the bug is not known.
+
+Sometimes people give a few sketchy facts and ask, ``Does this ring a
+bell?''
+This cannot help us fix a bug, so it is rarely helpful.
+We respond by asking for enough details to enable us to investigate.
+You might as well expedite matters by sending them to begin with.
+(Besides, there are enough bells ringing around here as it is.)
+
+Try to make your bug report self-contained.
+If we have to ask you for
+more information, it is best if you include all the previous information
+in your response, as well as the information that was missing.
+
+Please report each bug in a separate message.
+This makes it easier for
+us to track which bugs have been fixed and to forward your bugs reports
+to the appropriate maintainer.
+
+Do not compress and encode any part of your bug report using programs
+such as @file{uuencode}.
+If you do so it will slow down the processing
+of your bug.
+If you must submit multiple large files, use @file{shar},
+which allows us to read your message without having to run any
+decompression programs.
+
+(As a special exception for GNU Fortran bug-reporting, at least
+for now, if you are sending more than a few lines of code, if
+your program's source file format contains ``interesting'' things
+like trailing spaces or strange characters, or if you need to
+include binary data files, it is acceptable to put all the
+files together in a @code{tar} archive, and, whether you need to
+do that, it is acceptable to then compress the single file (@code{tar}
+archive or source file)
+using @code{gzip} and encode it via @code{uuencode}.
+Do not use any MIME stuff---the current maintainer can't decode this.
+Using @code{compress} instead of @code{gzip} is acceptable, assuming
+you have licensed the use of the patented algorithm in
+@code{compress} from Unisys.)
+
+To enable someone to investigate the bug, you should include all these
+things:
+
+@itemize @bullet
+@item
+The version of GNU Fortran.
+You can get this by running @code{g77} with the @samp{-v} option.
+(Ignore any error messages that might be displayed
+when the linker is run.)
+
+Without this, we won't know whether there is any point in looking for
+the bug in the current version of GNU Fortran.
+
+@item
+@cindex preprocessor
+@cindex cpp program
+@cindex programs, cpp
+A complete input file that will reproduce the bug.
+If the bug is in the compiler proper (@file{f771}) and
+you are using the C preprocessor, run your
+source file through the C preprocessor by doing @samp{g77 -E
+@var{sourcefile} > @var{outfile}}, then include the contents of
+@var{outfile} in the bug report.  (When you do this, use the same
+@samp{-I}, @samp{-D} or @samp{-U} options that you used in actual
+compilation.)
+
+A single statement is not enough of an example.
+In order to compile it,
+it must be embedded in a complete file of compiler input; and the bug
+might depend on the details of how this is done.
+
+Without a real example one can compile, all anyone can do about your bug
+report is wish you luck.  It would be futile to try to guess how to
+provoke the bug.  For example, bugs in register allocation and reloading
+frequently depend on every little detail of the function they happen in.
+
+@item
+@cindex included files
+@cindex INCLUDE directive
+@cindex directive, INCLUDE
+@cindex #include directive
+@cindex directive, #include
+Note that you should include with your bug report any files
+included by the source file
+(via the @code{#include} or @code{INCLUDE} directive)
+that you send, and any files they include, and so on.
+
+It is not necessary to replace
+the @code{#include} and @code{INCLUDE} directives
+with the actual files in the version of the source file that
+you send, but it might make submitting the bug report easier
+in the end.
+However, be sure to @emph{reproduce} the bug using the @emph{exact}
+version of the source material you submit, to avoid wild-goose
+chases.
+
+@item
+The command arguments you gave GNU Fortran to compile that example
+and observe the bug.  For example, did you use @samp{-O}?  To guarantee
+you won't omit something important, list all the options.
+
+If we were to try to guess the arguments, we would probably guess wrong
+and then we would not encounter the bug.
+
+@item
+The type of machine you are using, and the operating system name and
+version number.
+(Much of this information is printed by @samp{g77 -v}---if you
+include that, send along any additional info you have that you
+don't see clearly represented in that output.)
+
+@item
+The operands you gave to the @code{configure} command when you installed
+the compiler.
+
+@item
+A complete list of any modifications you have made to the compiler
+source.  (We don't promise to investigate the bug unless it happens in
+an unmodified compiler.  But if you've made modifications and don't tell
+us, then you are sending us on a wild-goose chase.)
+
+Be precise about these changes.  A description in English is not
+enough---send a context diff for them.
+
+Adding files of your own (such as a machine description for a machine we
+don't support) is a modification of the compiler source.
+
+@item
+Details of any other deviations from the standard procedure for installing
+GNU Fortran.
+
+@item
+A description of what behavior you observe that you believe is
+incorrect.  For example, ``The compiler gets a fatal signal,'' or,
+``The assembler instruction at line 208 in the output is incorrect.''
+
+Of course, if the bug is that the compiler gets a fatal signal, then one
+can't miss it.  But if the bug is incorrect output, the maintainer might
+not notice unless it is glaringly wrong.  None of us has time to study
+all the assembler code from a 50-line Fortran program just on the chance that
+one instruction might be wrong.  We need @emph{you} to do this part!
+
+Even if the problem you experience is a fatal signal, you should still
+say so explicitly.  Suppose something strange is going on, such as, your
+copy of the compiler is out of synch, or you have encountered a bug in
+the C library on your system.  (This has happened!)  Your copy might
+crash and the copy here would not.  If you @i{said} to expect a crash,
+then when the compiler here fails to crash, we would know that the bug
+was not happening.  If you don't say to expect a crash, then we would
+not know whether the bug was happening.  We would not be able to draw
+any conclusion from our observations.
+
+If the problem is a diagnostic when building GNU Fortran with some other
+compiler, say whether it is a warning or an error.
+
+Often the observed symptom is incorrect output when your program is run.
+Sad to say, this is not enough information unless the program is short
+and simple.  None of us has time to study a large program to figure out
+how it would work if compiled correctly, much less which line of it was
+compiled wrong.  So you will have to do that.  Tell us which source line
+it is, and what incorrect result happens when that line is executed.  A
+person who understands the program can find this as easily as finding a
+bug in the program itself.
+
+@item
+If you send examples of assembler code output from GNU Fortran,
+please use @samp{-g} when you make them.  The debugging information
+includes source line numbers which are essential for correlating the
+output with the input.
+
+@item
+If you wish to mention something in the GNU Fortran source, refer to it by
+context, not by line number.
+
+The line numbers in the development sources don't match those in your
+sources.  Your line numbers would convey no convenient information to the
+maintainers.
+
+@item
+Additional information from a debugger might enable someone to find a
+problem on a machine which he does not have available.  However, you
+need to think when you collect this information if you want it to have
+any chance of being useful.
+
+@cindex backtrace for bug reports
+For example, many people send just a backtrace, but that is never
+useful by itself.  A simple backtrace with arguments conveys little
+about GNU Fortran because the compiler is largely data-driven; the same
+functions are called over and over for different RTL insns, doing
+different things depending on the details of the insn.
+
+Most of the arguments listed in the backtrace are useless because they
+are pointers to RTL list structure.  The numeric values of the
+pointers, which the debugger prints in the backtrace, have no
+significance whatever; all that matters is the contents of the objects
+they point to (and most of the contents are other such pointers).
+
+In addition, most compiler passes consist of one or more loops that
+scan the RTL insn sequence.  The most vital piece of information about
+such a loop---which insn it has reached---is usually in a local variable,
+not in an argument.
+
+@findex debug_rtx
+What you need to provide in addition to a backtrace are the values of
+the local variables for several stack frames up.  When a local
+variable or an argument is an RTX, first print its value and then use
+the GDB command @code{pr} to print the RTL expression that it points
+to.  (If GDB doesn't run on your machine, use your debugger to call
+the function @code{debug_rtx} with the RTX as an argument.)  In
+general, whenever a variable is a pointer, its value is no use
+without the data it points to.
+@end itemize
+
+Here are some things that are not necessary:
+
+@itemize @bullet
+@item
+A description of the envelope of the bug.
+
+Often people who encounter a bug spend a lot of time investigating
+which changes to the input file will make the bug go away and which
+changes will not affect it.
+
+This is often time consuming and not very useful, because the way we
+will find the bug is by running a single example under the debugger with
+breakpoints, not by pure deduction from a series of examples.  You might
+as well save your time for something else.
+
+Of course, if you can find a simpler example to report @emph{instead} of
+the original one, that is a convenience.  Errors in the output will be
+easier to spot, running under the debugger will take less time, etc.
+Most GNU Fortran bugs involve just one function, so the most straightforward
+way to simplify an example is to delete all the function definitions
+except the one where the bug occurs.  Those earlier in the file may be
+replaced by external declarations if the crucial function depends on
+them.  (Exception: inline functions might affect compilation of functions
+defined later in the file.)
+
+However, simplification is not vital; if you don't want to do this,
+report the bug anyway and send the entire test case you used.
+
+@item
+In particular, some people insert conditionals @samp{#ifdef BUG} around
+a statement which, if removed, makes the bug not happen.  These are just
+clutter; we won't pay any attention to them anyway.  Besides, you should
+send us preprocessor output, and that can't have conditionals.
+
+@item
+A patch for the bug.
+
+A patch for the bug is useful if it is a good one.  But don't omit the
+necessary information, such as the test case, on the assumption that a
+patch is all we need.  We might see problems with your patch and decide
+to fix the problem another way, or we might not understand it at all.
+
+Sometimes with a program as complicated as GNU Fortran it is very hard to
+construct an example that will make the program follow a certain path
+through the code.  If you don't send the example, we won't be able to
+construct one, so we won't be able to verify that the bug is fixed.
+
+And if we can't understand what bug you are trying to fix, or why your
+patch should be an improvement, we won't install it.  A test case will
+help us to understand.
+
+@xref{Sending Patches}, for guidelines on how to make it easy for us to
+understand and install your patches.
+
+@item
+A guess about what the bug is or what it depends on.
+
+Such guesses are usually wrong.  Even the maintainer can't guess right
+about such things without first using the debugger to find the facts.
+
+@item
+A core dump file.
+
+We have no way of examining a core dump for your type of machine
+unless we have an identical system---and if we do have one,
+we should be able to reproduce the crash ourselves.
+@end itemize
+
+@node Sending Patches
+@section Sending Patches for GNU Fortran
+
+If you would like to write bug fixes or improvements for the GNU Fortran
+compiler, that is very helpful.
+Send suggested fixes to the bug report
+mailing list, @email{fortran@@gnu.ai.mit.edu}.
+
+Please follow these guidelines so we can study your patches efficiently.
+If you don't follow these guidelines, your information might still be
+useful, but using it will take extra work.  Maintaining GNU Fortran is a lot
+of work in the best of circumstances, and we can't keep up unless you do
+your best to help.
+
+@itemize @bullet
+@item
+Send an explanation with your changes of what problem they fix or what
+improvement they bring about.  For a bug fix, just include a copy of the
+bug report, and explain why the change fixes the bug.
+
+(Referring to a bug report is not as good as including it, because then
+we will have to look it up, and we have probably already deleted it if
+we've already fixed the bug.)
+
+@item
+Always include a proper bug report for the problem you think you have
+fixed.  We need to convince ourselves that the change is right before
+installing it.  Even if it is right, we might have trouble judging it if
+we don't have a way to reproduce the problem.
+
+@item
+Include all the comments that are appropriate to help people reading the
+source in the future understand why this change was needed.
+
+@item
+Don't mix together changes made for different reasons.
+Send them @emph{individually}.
+
+If you make two changes for separate reasons, then we might not want to
+install them both.  We might want to install just one.  If you send them
+all jumbled together in a single set of diffs, we have to do extra work
+to disentangle them---to figure out which parts of the change serve
+which purpose.  If we don't have time for this, we might have to ignore
+your changes entirely.
+
+If you send each change as soon as you have written it, with its own
+explanation, then the two changes never get tangled up, and we can
+consider each one properly without any extra work to disentangle them.
+
+Ideally, each change you send should be impossible to subdivide into
+parts that we might want to consider separately, because each of its
+parts gets its motivation from the other parts.
+
+@item
+Send each change as soon as that change is finished.  Sometimes people
+think they are helping us by accumulating many changes to send them all
+together.  As explained above, this is absolutely the worst thing you
+could do.
+
+Since you should send each change separately, you might as well send it
+right away.  That gives us the option of installing it immediately if it
+is important.
+
+@item
+Use @samp{diff -c} to make your diffs.  Diffs without context are hard
+for us to install reliably.  More than that, they make it hard for us to
+study the diffs to decide whether we want to install them.  Unidiff
+format is better than contextless diffs, but not as easy to read as
+@samp{-c} format.
+
+If you have GNU @code{diff}, use @samp{diff -cp}, which shows the name of the
+function that each change occurs in.
+(The maintainer of GNU Fortran currently uses @samp{diff -rcp2N}.)
+
+@item
+Write the change log entries for your changes.  We get lots of changes,
+and we don't have time to do all the change log writing ourselves.
+
+Read the @file{ChangeLog} file to see what sorts of information to put
+in, and to learn the style that we use.  The purpose of the change log
+is to show people where to find what was changed.  So you need to be
+specific about what functions you changed; in large functions, it's
+often helpful to indicate where within the function the change was.
+
+On the other hand, once you have shown people where to find the change,
+you need not explain its purpose.  Thus, if you add a new function, all
+you need to say about it is that it is new.  If you feel that the
+purpose needs explaining, it probably does---but the explanation will be
+much more useful if you put it in comments in the code.
+
+If you would like your name to appear in the header line for who made
+the change, send us the header line.
+
+@item
+When you write the fix, keep in mind that we can't install a change that
+would break other systems.
+
+People often suggest fixing a problem by changing machine-independent
+files such as @file{toplev.c} to do something special that a particular
+system needs.  Sometimes it is totally obvious that such changes would
+break GNU Fortran for almost all users.  We can't possibly make a change like
+that.  At best it might tell us how to write another patch that would
+solve the problem acceptably.
+
+Sometimes people send fixes that @emph{might} be an improvement in
+general---but it is hard to be sure of this.  It's hard to install
+such changes because we have to study them very carefully.  Of course,
+a good explanation of the reasoning by which you concluded the change
+was correct can help convince us.
+
+The safest changes are changes to the configuration files for a
+particular machine.  These are safe because they can't create new bugs
+on other machines.
+
+Please help us keep up with the workload by designing the patch in a
+form that is good to install.
+@end itemize
+
+@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
+GNU CC distribution.
+
+@item
+Send a message to @email{fortran@@gnu.ai.mit.edu}.
+@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 @code{g77}, first decide
+what kind of option you wish to add.
+Search the @code{g77} and @code{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 @code{g77} and @code{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{gcc/f/lang-options.h},
+which is used during the build of @code{gcc} to
+build a list of all options that are accepted by
+at least one language's compiler.
+This list goes into the @samp{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 @samp{lang_option_decode}, which, for
+@code{g77}, is in @file{gcc/f/com.c} and just
+calls @samp{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 @samp{-fno-asm} option;
+even though the @code{f771} version of @samp{lang_decode_option}
+rejects @samp{-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 @samp{-fno-asm}---perhaps
+a warning about this would be helpful if it were
+possible.
+
+Code that processes Fortran options is found in
+@file{gcc/f/top.c}, function @samp{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{gcc/f/top.c}.
+Many of these defaults are actually macros defined
+in @file{gcc/f/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 @code{g77}.
+
+Accessor macros for Fortran options, used by code
+in the @code{g77} FFE, are defined in @file{gcc/f/top.h}.
+
+@emph{Compiler options} are listed in @file{gcc/toplev.c}
+in the array @samp{f_options}.
+An option not listed in @samp{lang_options} is
+looked up in @samp{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 way @code{f771} handles the @samp{-fset-g77-defaults}
+option, which is always provided as the first option when
+called by @code{g77} or @code{gcc}.
+
+This code is in @samp{ffe_decode_options} in @file{gcc/f/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 @samp{-fset-g77-defaults} option is passed to @code{f771}
+automatically because of the specification information
+kept in @file{gcc/f/lang-specs.h}.
+This file tells the @code{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{gcc/f/lang-specs.h} that @samp{-fset-g77-defaults},
+@samp{-fversion}, and other options are passed, as appropriate,
+even when the user has not explicitly specified them.
+Other ``internal'' options such as @samp{-quiet} also
+are passed via this mechanism.
+
+@node Projects
+@chapter Projects
+@cindex projects
+
+If you want to contribute to @code{g77} by doing research,
+design, specification, documentation, coding, or testing,
+the following information should give you some ideas.
+
+@menu
+* Efficiency::               Make @code{g77} itself compile code faster.
+* Better Optimization::      Teach @code{g77} to generate faster code.
+* Simplify Porting::         Make @code{g77} easier to configure, build,
+                             and install.
+* More Extensions::          Features many users won't know to ask for.
+* Machine Model::            @code{g77} should better leverage @code{gcc}.
+* Internals Documentation::  Make maintenance easier.
+* Internals Improvements::   Make internals more robust.
+* Better Diagnostics::       Make using @code{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 @samp{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 @code{g77}, don't pass line/column pairs where
+a simple @samp{ffewhere} type, which points to the error as much as is
+desired by the configuration, will do, and don't pass @samp{ffelexToken} types
+where a simple @samp{ffewhere} type will do.
+Then, allow new default
+configuration of @samp{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 @code{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 @code{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{libf2c} and #include'ing the resulting
+file in @code{f2c}+@code{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 @samp{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{libf2c} would be moved at least to the
+@code{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
+@code{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 @code{g77} uses
+@code{gcc} rather than @code{f2c} calling conventions.)
+
+@item
+Do something useful with @samp{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 @code{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{libf2c}) should improve portability as well as
+produce more optimal code.
+Further, @code{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, @code{g77} should produce the equivalent
+of a @code{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, @code{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 @code{g77}, and Fortran in
+general, in the long run.
+Some of these items really pertain to improving @code{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
+@cindex concatenation
+@cindex CHARACTER*(*)
+Support arbitrary operands for concatenation, even in contexts where
+run-time allocation is required.
+
+@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{libf2c} 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 @code{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{libf2c} or its replacement.
+
+@item
+F90 and @code{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 @code{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 @samp{REAL_VALUE_TYPE} to represent floating-point constants
+exclusively so the target float format need not be required.
+This
+means changing the way @code{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 @code{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 @code{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 @code{g77} works and how to port it is needed.
+Much of this should be done only after the redesign planned for
+0.6 is complete.
+
+@node Internals Improvements
+@section Internals Improvements
+
+Some more items that would make @code{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 @samp{-D} to establish requirements
+to achieve desired implementation dialect via @file{proj.h}.
+
+@item
+Clean up used tokens and @samp{ffewhere}s in @samp{ffeglobal_terminate_1}.
+
+@item
+Replace @file{sta.c} @samp{outpooldisp} mechanism with @samp{malloc_pool_use}.
+
+@item
+Check for @samp{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 @code{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 @samp{ffebld_new} calls (those outside of @file{ffeexpr.c} or
+inside but invoked via paths not involving @samp{ffeexpr_lhs} or
+@samp{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 @samp{ffebld_list_new} (or whatever) calls might not be matched by
+@samp{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
+@samp{ffestorag} objects, so maybe the backend (and other parts of the front
+end) can notice that and handle like an @samp{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),
+@samp{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
+@end ifset
+
+@ifset USING
+@node Diagnostics
+@chapter Diagnostics
+@cindex diagnostics
+
+Some diagnostics produced by @code{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 @code{info}
+command that displays the explanation is given in 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 @code{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 @code{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.
+@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
+@samp{REAL}) or @samp{DIMAG(@var{expr})} (if @var{intrinsic}
+is @samp{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 @code{g77} option @samp{-ff90}, to enable the
+Fortran 90 interpretation.
+
+@item
+Compile with the @code{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 Contact via Internet email: burley@@gnu.ai.mit.edu
+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 @code{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 @samp{-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 @samp{-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 @code{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 @code{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 @code{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 @code{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 @code{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 @samp{-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 @samp{-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 @code{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 @samp{-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.
+
+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.
+Comment lines are indicated by the letter @samp{C} or the symbol
+@samp{*} in column 1.
+(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 @samp{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 @samp{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} or @samp{.for}, the file
+will normally be compiled @emph{without} preprocessing by @code{g77}.
+
+Change the file's suffix from @samp{.f} to @samp{.F} (or, on
+systems with case-insensitive file names, to @samp{.fpp}) or
+from @samp{.for} to @samp{.fpp}.
+@code{g77} compiles files with such names @emph{with}
+preprocessing.
+
+Or, learn how to use @code{gcc}'s @samp{-x} option to specify
+the language @samp{f77-cpp-input} for Fortran files that
+require preprocessing.
+@xref{Overall Options,,gcc,Using and Porting GNU CC}.
+
+@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).
+
+These disagreements, if not diagnosed, could result in a
+compiler crash if the compiler attempted to inline a reference
+to @var{name} within a calling program unit that disagreed
+with the @var{name} program unit regarding whether the
+procedure is a subroutine or function, the type of the
+return value of the procedure (if it is a function), the
+number of arguments the procedure accepts, or the type
+of each argument.
+
+Such disagreements @emph{should} be fixed in the Fortran
+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 by @code{g77} with the @samp{-fno-globals} option.
+
+The @samp{-fno-globals} option disables these diagnostics, and
+also disables all inlining of references to global procedures
+to avoid compiler crashes.
+The diagnostics are actually produced, but as warnings, unless
+the @samp{-Wno-globals} option also is specified.
+
+After using @samp{-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.
+
+@end ifset
+
+@node Index
+@unnumbered Index
+
+@printindex cp
+@summarycontents
+@contents
+@bye
diff --git a/gcc/f/gbe/2.7.2.2.diff b/gcc/f/gbe/2.7.2.2.diff
new file mode 100644
index 00000000000..e99ba671741
--- /dev/null
+++ b/gcc/f/gbe/2.7.2.2.diff
@@ -0,0 +1,11296 @@
+IMPORTANT: After applying this patch, you must rebuild the
+Info documentation derived from the Texinfo files in the
+gcc distribution, as this patch does not include patches
+to any derived files (due to differences in the way gcc
+version 2.7.2.2 is obtained by users).  Use the following
+command sequence after applying this patch:
+
+  cd gcc-2.7.2.2; make -f Makefile.in gcc.info
+
+If that fails due to `makeinfo' not being installed, obtain
+texinfo-3.11.tar.gz from a GNU distribution site, unpack,
+build, and install it, and try the above command sequence
+again.
+
+
+diff -rcp2N gcc-2.7.2.2/ChangeLog g77-new/ChangeLog
+*** gcc-2.7.2.2/ChangeLog	Thu Feb 20 19:24:10 1997
+--- g77-new/ChangeLog	Mon Aug 11 06:48:02 1997
+***************
+*** 1,2 ****
+--- 1,244 ----
++ Sun Aug 10 18:14:24 1997  Craig Burley  <burley@gnu.ai.mit.edu>
++ 
++ 	Integrate C front end part of patch for better alias
++ 	handling from John Carr <jfc@mit.edu>:
++ 	* c-decl.c (grokdeclarator): Check for RID_RESTRICT
++ 	flag; diagnose certain misuses; set DECL_RESTRICT as
++ 	appropriate.
++ 	* c-lex.c (init_lex): Set up RID_RESTRICT pointer.
++ 	Unset `restrict' as reserved word.
++ 	* c-lex.h: Replace RID_NOALIAS with RID_RESTRICT.
++ 	* c-parse.gperf: Add `restrict' and `__restrict'
++ 	keywords.
++ 	* tree.h: Add DECL_RESTRICT flag.
++ 
++ Sun Aug 10 14:50:30 1997  Jim Wilson  <wilson@cygnus.com>
++ 
++ 	* sdbout.c (plain_type_1, case ARRAY_TYPE): Verify that TYPE_DOMAIN
++ 	has integer TYPE_{MAX,MIN}_VALUE before using them.
++ 
++ Mon Jul 28 15:35:38 1997  Craig Burley  <burley@gnu.ai.mit.edu>
++ 
++ 	* combine.c (num_sign_bit_copies): Speed up the 961126-1.c
++ 	case of repeated (neg (neg (neg ...))) so c-torture runs
++ 	in less time.
++ 
++ 	* reload.c (find_reloads_toplev, find_reloads_address):
++ 	These now return whether replacement by a constant, so
++ 	caller can know to do other replacements.  Currently if
++ 	caller doesn't want that info and such replacement would
++ 	happen, we crash so as to investigate the problem and
++ 	learn more about it.  All callers updated.
++ 	(find_reloads): If pseudo replaced by constant, always
++ 	update duplicates of it.
++ 
++ Mon Jul 21 00:00:24 1997  Craig Burley  <burley@gnu.ai.mit.edu>
++ 
++ 	* fold-const.c (size_binop): Make sure overflows
++ 	are flagged properly, so as to avoid silently generating
++ 	bad code for, e.g., a too-large array.
++ 
++ Sun Jul 13 22:23:14 1997  Craig Burley  <burley@gnu.ai.mit.edu>
++ 
++ 	* stmt.c (expand_expr_stmt): Must generate code for
++ 	statements within an expression (gcc's `({ ... )}')
++ 	even if -fsyntax-only.
++ 
++ Mon Jun 30 17:23:07 1997  Michael Meissner  <meissner@cygnus.com>
++ 
++ 	* gcc.c (process_command): If -save-temps and -pipe were specified
++ 	together, don't do -pipe.
++ 
++ Thu Jun 26 05:40:46 1997  Craig Burley  <burley@gnu.ai.mit.edu>
++ 
++ 	* stor-layout.c (get_best_mode): Handle negative bitpos
++ 	correctly, so caller doesn't get into infinite recursion
++ 	trying to cope with a spurious VOIDmode.
++ 
++ Tue Jun 24 19:46:31 1997  Craig Burley  <burley@gnu.ai.mit.edu>
++ 
++ 	* varasm.c (assemble_variable): If low part of size
++ 	doesn't fit in an int, variable is too large.
++ 
++ Sat Jun 21 12:09:00 1997  Craig Burley  <burley@gnu.ai.mit.edu>
++ 
++ 	* toplev.c (rest_of_compilation): Also temporarily set
++ 	flag_unroll_all_loops to 0 during first of two calls
++ 	to loop_optimize, and clean up code a bit to make it
++ 	easier to read.
++ 
++ 	* expr.c (safe_from_p_1, safe_from_p): Fix these to use
++ 	TREE_SET_CODE instead of TREE_CODE.
++ 
++ Thu Jun 19 19:30:47 1997  Craig Burley  <burley@gnu.ai.mit.edu>
++ 
++ 	* config/alpha/alpha.c: Don't include <stamp.h> on
++ 	GNU Linux machines.
++ 
++ 	* config/alpha/elf.c: New file for ELF systems.
++ 
++ 	* config/alpha/xm-alpha.h: Don't declare alloca()
++ 	if it's already a macro (probably defined in stdlib.h).
++ 
++ 	* config/alpha/xm-linux.h (HAVE_STRERROR): #define
++ 	this, according to what various people suggest.
++ 
++ 	* config.guess, configure: Make some (hopefully safe)
++ 	changes, based mostly on gcc-2.8.0-in-development,
++ 	in the hopes that these make some systems configure
++ 	"out of the box" more easily, especially Alpha systems.
++ 
++ Mon Jun  9 04:26:53 1997  Craig Burley  <burley@gnu.ai.mit.edu>
++ 
++ 	* expr.c (safe_from_p): Don't examine a given SAVE_EXPR
++ 	node more than once, to avoid combinatorial explosion
++ 	in complex expressions.  Fortran case that triggered
++ 	this had a complicated *and* complex expression with
++ 	293 unique nodes, resulting in 28 minutes of compile
++ 	time mostly spent in a single top-level safe_from_p()
++ 	call due to all the redundant SAVE_EXPR traversals.
++ 	This change reduced the time to around 2 seconds.
++ 	(safe_from_p_1): New helper function that does almost
++ 	exactly what the old safe_from_p() did.
++ 
++ Sun May 18 21:18:48 1997  Craig Burley  <burley@gnu.ai.mit.edu>
++ 
++ 	* fold-const.c (fold): Clarify why TRUNC_DIV_EXPR
++ 	and FLOOR_DIV_EXPR aren't rewritten to EXACT_DIV_EXPR,
++ 	clean up related code.
++ 
++ Sat May  3 13:53:00 1997  Craig Burley  <burley@gnu.ai.mit.edu>
++ 
++ 	* config.sub: Change all `i[345]' to `i[3456]' to
++ 	support Pentium Pro (this change was already made
++ 	in configure for gcc-2.7.2.2).
++ 
++ 	From Toon Moene <toon@moene.indiv.nluug.nl>:
++ 	* toplev.c (rest_of_compilation): Unroll loops
++ 	only the final time through loop optimization.
++ 
++ Sun Apr 20 10:45:35 1997  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
++ 
++ 	* final.c (profile_function): Only call ASM_OUTPUT_REG_{PUSH,POP}
++ 	if defined.
++ 
++ Wed Apr 16 22:26:16 1997  Craig Burley  <burley@gnu.ai.mit.edu>
++ 
++ 	* alias.c, cse.c, loop.c, rtl.c, rtl.h, sched.c:
++ 	Make changes submitted by <jfc@mit.edu>.
++ 
++ Sun Apr 13 19:32:53 1997  Craig Burley  <burley@gnu.ai.mit.edu>
++ 
++ 	* fold-const.c (fold): If extra warnings enabled,
++ 	warn about integer division by zero.
++ 
++ Sun Apr 13 08:15:31 1997  Bernd Schmidt  <crux@Pool.Informatik.RWTH-Aachen.DE>
++ 
++ 	* final.c (profile_function): Save the static chain register
++ 	around the call to the profiler function.
++ 
++ Sat Apr 12 14:56:42 1997  Craig Burley  <burley@gnu.ai.mit.edu>
++ 
++ 	* unroll.c (find_splittable_givs): Permit more cases
++ 	of mult_val/add_val to agree by using rtx_equal_p
++ 	to compare them instead of requiring them to be
++ 	integers with the same value.  Also don't bother
++ 	checking if ADDRESS_COST not defined (they will be
++ 	equal in that case).
++ 
++ Fri Apr 11 03:30:04 1997  Craig Burley  <burley@gnu.ai.mit.edu>
++ 
++ 	* unroll.c (find_splittable_givs): Must create a new
++ 	register if the mult_val and add_val fields don't
++ 	agree.
++ 
++ Fri Apr  4 23:00:55 1997  Craig Burley  <burley@gnu.ai.mit.edu>
++ 
++ 	* fold-const.c (fold): Don't call multiple_of_p if
++ 	arg1 is constant zero, to avoid crashing; simplify
++ 	code accordingly.
++ 
++ Wed Feb 26 13:09:33 1997  Michael Meissner  <meissner@cygnus.com>
++ 
++ 	* reload.c (debug_reload): Fix format string to print
++ 	reload_nocombine[r].
++ 
++ Sun Feb 23 15:26:53 1997  Craig Burley  <burley@gnu.ai.mit.edu>
++ 
++ 	* fold-const.c (multiple_of_p): Clean up and improve.
++ 	(fold): Clean up invocation of multiple_of_p.
++ 
++ Sat Feb  8 04:53:27 1997  Craig Burley  <burley@gnu.ai.mit.edu>
++ 
++ 	From <jfc@jfc.tiac.net> Fri, 07 Feb 1997 22:02:21 -0500:
++ 	* alias.c (init_alias_analysis): Reduce amount of time
++ 	needed to simplify the reg_base_value array in the
++ 	typical case (especially involving function inlining).
++ 
++ Fri Jan 10 17:22:17 1997  Craig Burley  <burley@gnu.ai.mit.edu>
++ 
++ 	Minor improvements/fixes to better alias handling:
++ 	* Makefile.in (alias.o): Fix typo in rule (was RLT_H).
++ 	* cse.c, sched.c: Fix up some indenting.
++ 	* toplev.c: Add -fargument-alias flag, so Fortran users
++ 	can turn C-style aliasing on once g77 defaults to
++ 	-fargument-noalias-global.
++ 
++ 	Integrate patch for better alias handling from
++ 	John Carr <jfc@mit.edu>:
++ 	* Makefile.in (OBJS, alias.o): New module and rule.
++ 	* alias.c: New source module.
++ 	* calls.c (expand_call): Recognize alias status of calls
++ 	to malloc().
++ 	* combine.c (distribute_notes): New REG_NOALIAS note.
++ 	* rtl.h (REG_NOALIAS): Ditto.
++ 	Many other changes for new alias.c module.
++ 	* cse.c: Many changes, and much code moved into alias.c.
++ 	* flags.h (flag_alias_check, flag_argument_noalias):
++ 	New flags.
++ 	* toplev.c: New flags and related options.
++ 	* local-alloc.c (validate_equiv_mem_from_store):
++ 	Caller of true_dependence changed.
++ 	* loop.c (NUM_STORES): Increase to 50 from 20.
++ 	(prescan_loop): "const" functions don't alter unknown addresses.
++ 	(invariant_p): Caller of true_dependence changed.
++ 	(record_giv): Zero new unrolled and shared flags.
++ 	(emit_iv_add_mult): Record base value for register.
++ 	* sched.c: Many changes, mostly moving code to alias.c.
++ 	(sched_note_set): SCHED_SORT macro def form, but not function,
++ 	inexplicably changed.
++ 	* unroll.c: Record base values for registers, etc.
++ 
++ Fri Jan  3 04:01:00 1997  Craig Burley  <burley@gnu.ai.mit.edu>
++ 
++ 	* loop.c (check_final_value): Handle insns with no luid's
++ 	appropriately, instead of crashing on INSN_LUID macro
++ 	invocations.
++ 
++ Mon Dec 23 00:49:19 1996  Craig Burley  <burley@gnu.ai.mit.edu>
++ 
++ 	* config/alpha/alpha.md: Fix pattern that matches if_then_else
++ 	involving DF target, DF comparison, SF source.
++ 
++ Fri Dec 20 15:42:52 1996  Craig Burley  <burley@gnu.ai.mit.edu>
++ 
++ 	* fold-const.c (multiple_of_p): New function.
++ 	(fold): Use new function to turn *_DIV_EXPR into EXACT_DIV_EXPR.
++ 
++ Tue Oct 22 18:32:20 1996  Jim Wilson  <wilson@cygnus.com>
++ 
++ 	* unroll.c (unroll_loop): Always reject loops with unbalanced blocks.
++ 
++ Tue Sep 24 19:37:00 1996  Jim Wilson  <wilson@cygnus.com>
++ 
++ 	* reload.c (push_secondary_reload): Do strip paradoxical SUBREG
++ 	even if reload_class is CLASS_CANNOT_CHANGE_SIZE.  Change reload_mode
++ 	to mode in SECONDARY_MEMORY_NEEDED and get_secondary_mem calls.
++ 
++ Mon Aug  5 16:53:36 1996  Doug Evans  <dje@fallis.cygnus.com>
++ 
++ 	* stor-layout.c (layout_record): Correct overflow test for 0 sized
++ 	fields.
++ 
+  Sat Jun 29 12:33:39 1996  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
+  
+*************** Tue Jun 11 20:18:03 1996  Per Bothner <b
+*** 8,11 ****
+--- 250,259 ----
+  	* alpha.h (FIXPROTO_INIT):  Define new macro.
+  
++ Sat May 18 20:17:27 1996  Jim Wilson  <wilson@cygnus.com>
++ 
++ 	* unroll.c (copy_loop_body): When update split DEST_ADDR giv,
++ 	check to make sure it was split.
++ 	(find_splittable_givs): Fix reversed test of verify_addresses result.
++ 
+  Fri May 10 18:35:00 1996  Richard Kenner  (kenner@vlsi1.ultra.nyu.edu)
+  
+*************** Mon Feb 19 07:35:07 1996  Torbjorn Granl
+*** 66,69 ****
+--- 314,322 ----
+          * rs6000.md (not:SI with assign and compare): Fix typo.
+  
++ Tue Feb 13 17:43:46 1996  Jim Wilson  <wilson@cygnus.com>
++ 
++ 	* integrate.c (save_constants_in_decl_trees): New function.
++ 	(save_for_inline_copying, save_for_inline_nocopy): Call it.
++ 
+  Wed Jan 24 18:00:12 1996  Brendan Kehoe  <brendan@lisa.cygnus.com>
+  
+*************** Tue Jan 16 06:01:28 1996  Thomas Graiche
+*** 81,88 ****
+--- 334,357 ----
+  	* i386/freebsd.h (ASM_WEAKEN_LABEL): Deleted; not supported.
+  
++ Mon Jan 15 07:22:59 1996  Michel Delval  (mfd@ccv.fr)
++ 
++ 	* reload.c (find_equiv_reg): Apply single_set, not PATTERN, to WHERE.
++ 
+  Sun Jan  7 17:11:11 1996  David Edelsohn  <edelsohn@mhpcc.edu>
+  
+  	* collect2.c (scan_libraries): Correct Import File ID interpretation.
+  
++ Mon Jan  1 09:05:07 1996  Richard Kenner  (kenner@vlsi1.ultra.nyu.edu)
++ 
++         * local-alloc.c (reg_equiv_replacement): New variable.
++         (memref_referenced_p, case REG): Check for reg_equiv_replacement.
++         (update_equiv_regs): reg_equiv_replacement now file-scope.
++ 
++ Fri Dec 22 17:29:42 1995  Richard Kenner  (kenner@vlsi1.ultra.nyu.edu)
++ 
++ 	* reload.c (find_valid_class): New function.
++ 	(push_reload): Use it in cases where a SUBREG and its contents
++ 	both need to be reloaded.
++ 
+  Thu Dec 28 22:24:53 1995  Michael Meissner  <meissner@tiktok.cygnus.com>
+  
+*************** Mon Dec 18 18:40:34 1995  Jim Wilson  <w
+*** 99,102 ****
+--- 368,376 ----
+  	above.
+  
++ Sun Dec 17 06:37:00 1995  Richard Kenner  (kenner@vlsi1.ultra.nyu.edu)
++ 
++ 	* reload.c (push_secondary_reload): Don't strip paradoxical SUBREG
++ 	if reload_class is CLASS_CANNOT_CHANGE_SIZE.
++ 
+  Sat Dec 16 07:03:33 1995  Philippe De Muyter (phdm@info.ucl.ac.be)
+  
+*************** Sat Dec  9 18:05:03 1995  Jim Wilson  <w
+*** 113,116 ****
+--- 387,395 ----
+  	* expr.c (expand_expr, case INDIRECT_REF): Correct typo in May 8
+  	change.
++ 
++ Fri Dec  8 19:17:30 1995  Mike Meissner  <meissner@beauty.cygnus.com>
++ 
++ 	* rs6000/rs6000.c (input_operand): Allow any integer constant, not
++ 	just integers that fit in 1 instruction.
+  
+  Sun Nov 26 14:47:42 1995  Richard Kenner  <kenner@mole.gnu.ai.mit.edu>
+diff -rcp2N gcc-2.7.2.2/Makefile.in g77-new/Makefile.in
+*** gcc-2.7.2.2/Makefile.in	Sun Nov 26 14:44:25 1995
+--- g77-new/Makefile.in	Sun Aug 10 18:46:06 1997
+*************** OBJS = toplev.o version.o tree.o print-t
+*** 519,523 ****
+   integrate.o jump.o cse.o loop.o unroll.o flow.o stupid.o combine.o \
+   regclass.o local-alloc.o global.o reload.o reload1.o caller-save.o \
+!  insn-peep.o reorg.o sched.o final.o recog.o reg-stack.o \
+   insn-opinit.o insn-recog.o insn-extract.o insn-output.o insn-emit.o \
+   insn-attrtab.o $(out_object_file) getpwd.o convert.o $(EXTRA_OBJS)
+--- 519,523 ----
+   integrate.o jump.o cse.o loop.o unroll.o flow.o stupid.o combine.o \
+   regclass.o local-alloc.o global.o reload.o reload1.o caller-save.o \
+!  insn-peep.o reorg.o alias.o sched.o final.o recog.o reg-stack.o \
+   insn-opinit.o insn-recog.o insn-extract.o insn-output.o insn-emit.o \
+   insn-attrtab.o $(out_object_file) getpwd.o convert.o $(EXTRA_OBJS)
+*************** LIB2FUNCS = _muldi3 _divdi3 _moddi3 _udi
+*** 570,574 ****
+      _fixxfdi _fixunsxfdi _floatdixf _fixunsxfsi \
+      _fixtfdi _fixunstfdi _floatditf \
+!     __gcc_bcmp _varargs _eprintf _op_new _op_vnew _new_handler _op_delete \
+      _op_vdel _bb _shtab _clear_cache _trampoline __main _exit _ctors _eh \
+      _pure
+--- 570,575 ----
+      _fixxfdi _fixunsxfdi _floatdixf _fixunsxfsi \
+      _fixtfdi _fixunstfdi _floatditf \
+!     __gcc_bcmp _varargs __dummy _eprintf \
+!     _op_new _op_vnew _new_handler _op_delete \
+      _op_vdel _bb _shtab _clear_cache _trampoline __main _exit _ctors _eh \
+      _pure
+*************** expr.o : expr.c $(CONFIG_H) $(RTL_H) $(T
+*** 1179,1183 ****
+     insn-flags.h insn-codes.h expr.h insn-config.h recog.h output.h \
+     typeclass.h bytecode.h bc-opcode.h bc-typecd.h bc-typecd.def bc-optab.h \
+!    bc-emit.h modemap.def
+  calls.o : calls.c $(CONFIG_H) $(RTL_H) $(TREE_H) flags.h expr.h insn-codes.h \
+     insn-flags.h
+--- 1180,1184 ----
+     insn-flags.h insn-codes.h expr.h insn-config.h recog.h output.h \
+     typeclass.h bytecode.h bc-opcode.h bc-typecd.h bc-typecd.def bc-optab.h \
+!    bc-emit.h modemap.def hard-reg-set.h
+  calls.o : calls.c $(CONFIG_H) $(RTL_H) $(TREE_H) flags.h expr.h insn-codes.h \
+     insn-flags.h
+*************** reorg.o : reorg.c $(CONFIG_H) $(RTL_H) c
+*** 1238,1241 ****
+--- 1239,1243 ----
+     basic-block.h regs.h insn-config.h insn-attr.h insn-flags.h recog.h \
+     flags.h output.h
++ alias.o : $(CONFIG_H) $(RTL_H) flags.h hard-reg-set.h regs.h
+  sched.o : sched.c $(CONFIG_H) $(RTL_H) basic-block.h regs.h hard-reg-set.h \
+     flags.h insn-config.h insn-attr.h
+diff -rcp2N gcc-2.7.2.2/alias.c g77-new/alias.c
+*** gcc-2.7.2.2/alias.c	Wed Dec 31 19:00:00 1969
+--- g77-new/alias.c	Thu Jul 10 20:08:43 1997
+***************
+*** 0 ****
+--- 1,996 ----
++ /* Alias analysis for GNU C, by John Carr (jfc@mit.edu).
++    Derived in part from sched.c  */
++ #include "config.h"
++ #include "rtl.h"
++ #include "expr.h"
++ #include "regs.h"
++ #include "hard-reg-set.h"
++ #include "flags.h"
++ 
++ static rtx canon_rtx			PROTO((rtx));
++ static int rtx_equal_for_memref_p	PROTO((rtx, rtx));
++ static rtx find_symbolic_term		PROTO((rtx));
++ static int memrefs_conflict_p		PROTO((int, rtx, int, rtx,
++ 					       HOST_WIDE_INT));
++ 
++ /* Set up all info needed to perform alias analysis on memory references.  */
++ 
++ #define SIZE_FOR_MODE(X) (GET_MODE_SIZE (GET_MODE (X)))
++ 
++ /* reg_base_value[N] gives an address to which register N is related.
++    If all sets after the first add or subtract to the current value
++    or otherwise modify it so it does not point to a different top level
++    object, reg_base_value[N] is equal to the address part of the source
++    of the first set.  The value will be a SYMBOL_REF, a LABEL_REF, or
++    (address (reg)) to indicate that the address is derived from an
++    argument or fixed register.  */
++ rtx *reg_base_value;
++ unsigned int reg_base_value_size;	/* size of reg_base_value array */
++ #define REG_BASE_VALUE(X) \
++ 	(REGNO (X) < reg_base_value_size ? reg_base_value[REGNO (X)] : 0)
++ 
++ /* Vector indexed by N giving the initial (unchanging) value known
++    for pseudo-register N.  */
++ rtx *reg_known_value;
++ 
++ /* Indicates number of valid entries in reg_known_value.  */
++ static int reg_known_value_size;
++ 
++ /* Vector recording for each reg_known_value whether it is due to a
++    REG_EQUIV note.  Future passes (viz., reload) may replace the
++    pseudo with the equivalent expression and so we account for the
++    dependences that would be introduced if that happens. */
++ /* ??? This is a problem only on the Convex.  The REG_EQUIV notes created in
++    assign_parms mention the arg pointer, and there are explicit insns in the
++    RTL that modify the arg pointer.  Thus we must ensure that such insns don't
++    get scheduled across each other because that would invalidate the REG_EQUIV
++    notes.  One could argue that the REG_EQUIV notes are wrong, but solving
++    the problem in the scheduler will likely give better code, so we do it
++    here.  */
++ char *reg_known_equiv_p;
++ 
++ /* Inside SRC, the source of a SET, find a base address.  */
++ 
++ /* When copying arguments into pseudo-registers, record the (ADDRESS)
++    expression for the argument directly so that even if the argument
++    register is changed later (e.g. for a function call) the original
++    value is noted.  */
++ static int copying_arguments;
++ 
++ static rtx
++ find_base_value (src)
++      register rtx src;
++ {
++   switch (GET_CODE (src))
++     {
++     case SYMBOL_REF:
++     case LABEL_REF:
++       return src;
++ 
++     case REG:
++       if (copying_arguments && REGNO (src) < FIRST_PSEUDO_REGISTER)
++ 	return reg_base_value[REGNO (src)];
++       return src;
++ 
++     case MEM:
++       /* Check for an argument passed in memory.  Only record in the
++ 	 copying-arguments block; it is too hard to track changes
++ 	 otherwise.  */
++       if (copying_arguments
++ 	  && (XEXP (src, 0) == arg_pointer_rtx
++ 	      || (GET_CODE (XEXP (src, 0)) == PLUS
++ 		  && XEXP (XEXP (src, 0), 0) == arg_pointer_rtx)))
++ 	return gen_rtx (ADDRESS, VOIDmode, src);
++       return 0;
++ 
++     case CONST:
++       src = XEXP (src, 0);
++       if (GET_CODE (src) != PLUS && GET_CODE (src) != MINUS)
++ 	break;
++       /* fall through */
++     case PLUS:
++     case MINUS:
++       /* Guess which operand to set the register equivalent to.  */
++       /* If the first operand is a symbol or the second operand is
++ 	 an integer, the first operand is the base address.  */
++       if (GET_CODE (XEXP (src, 0)) == SYMBOL_REF
++ 	  || GET_CODE (XEXP (src, 0)) == LABEL_REF
++ 	  || GET_CODE (XEXP (src, 1)) == CONST_INT)
++ 	return XEXP (src, 0);
++       /* If an operand is a register marked as a pointer, it is the base.  */
++       if (GET_CODE (XEXP (src, 0)) == REG
++ 	  && REGNO_POINTER_FLAG (REGNO (XEXP (src, 0))))
++ 	src = XEXP (src, 0);
++       else if (GET_CODE (XEXP (src, 1)) == REG
++ 	  && REGNO_POINTER_FLAG (REGNO (XEXP (src, 1))))
++ 	src = XEXP (src, 1);
++       else
++ 	return 0;
++       if (copying_arguments && REGNO (src) < FIRST_PSEUDO_REGISTER)
++ 	return reg_base_value[REGNO (src)];
++       return src;
++ 
++     case AND:
++       /* If the second operand is constant set the base
++ 	 address to the first operand. */
++       if (GET_CODE (XEXP (src, 1)) == CONST_INT
++ 	  && GET_CODE (XEXP (src, 0)) == REG)
++ 	{
++ 	  src = XEXP (src, 0);
++ 	  if (copying_arguments && REGNO (src) < FIRST_PSEUDO_REGISTER)
++ 	    return reg_base_value[REGNO (src)];
++ 	  return src;
++ 	}
++       return 0;
++ 
++     case HIGH:
++       return XEXP (src, 0);
++     }
++ 
++   return 0;
++ }
++ 
++ /* Called from init_alias_analysis indirectly through note_stores.  */
++ 
++ /* while scanning insns to find base values, reg_seen[N] is nonzero if
++    register N has been set in this function.  */
++ static char *reg_seen;
++ 
++ static
++ void record_set (dest, set)
++      rtx dest, set;
++ {
++   register int regno;
++   rtx src;
++ 
++   if (GET_CODE (dest) != REG)
++     return;
++ 
++   regno = REGNO (dest);
++ 
++   if (set)
++     {
++       /* A CLOBBER wipes out any old value but does not prevent a previously
++ 	 unset register from acquiring a base address (i.e. reg_seen is not
++ 	 set).  */
++       if (GET_CODE (set) == CLOBBER)
++ 	{
++ 	  reg_base_value[regno] = 0;
++ 	  return;
++ 	}
++       src = SET_SRC (set);
++     }
++   else
++     {
++       static int unique_id;
++       if (reg_seen[regno])
++ 	{
++ 	  reg_base_value[regno] = 0;
++ 	  return;
++ 	}
++       reg_seen[regno] = 1;
++       reg_base_value[regno] = gen_rtx (ADDRESS, Pmode,
++ 				       GEN_INT (unique_id++));
++       return;
++     }
++ 
++   /* This is not the first set.  If the new value is not related to the
++      old value, forget the base value. Note that the following code is
++      not detected:
++      extern int x, y;  int *p = &x; p += (&y-&x);
++      ANSI C does not allow computing the difference of addresses
++      of distinct top level objects.  */
++   if (reg_base_value[regno])
++     switch (GET_CODE (src))
++       {
++       case PLUS:
++       case MINUS:
++ 	if (XEXP (src, 0) != dest && XEXP (src, 1) != dest)
++ 	  reg_base_value[regno] = 0;
++ 	break;
++       case AND:
++ 	if (XEXP (src, 0) != dest || GET_CODE (XEXP (src, 1)) != CONST_INT)
++ 	  reg_base_value[regno] = 0;
++ 	break;
++       case LO_SUM:
++ 	if (XEXP (src, 0) != dest)
++ 	  reg_base_value[regno] = 0;
++ 	break;
++       default:
++ 	reg_base_value[regno] = 0;
++ 	break;
++       }
++   /* If this is the first set of a register, record the value.  */
++   else if ((regno >= FIRST_PSEUDO_REGISTER || ! fixed_regs[regno])
++ 	   && ! reg_seen[regno] && reg_base_value[regno] == 0)
++     reg_base_value[regno] = find_base_value (src);
++ 
++   reg_seen[regno] = 1;
++ }
++ 
++ /* Called from loop optimization when a new pseudo-register is created.  */
++ void
++ record_base_value (regno, val)
++      int regno;
++      rtx val;
++ {
++   if (!flag_alias_check || regno >= reg_base_value_size)
++     return;
++   if (GET_CODE (val) == REG)
++     {
++       if (REGNO (val) < reg_base_value_size)
++ 	reg_base_value[regno] = reg_base_value[REGNO (val)];
++       return;
++     }
++   reg_base_value[regno] = find_base_value (val);
++ }
++ 
++ static rtx
++ canon_rtx (x)
++      rtx x;
++ {
++   /* Recursively look for equivalences.  */
++   if (GET_CODE (x) == REG && REGNO (x) >= FIRST_PSEUDO_REGISTER
++       && REGNO (x) < reg_known_value_size)
++     return reg_known_value[REGNO (x)] == x
++       ? x : canon_rtx (reg_known_value[REGNO (x)]);
++   else if (GET_CODE (x) == PLUS)
++     {
++       rtx x0 = canon_rtx (XEXP (x, 0));
++       rtx x1 = canon_rtx (XEXP (x, 1));
++ 
++       if (x0 != XEXP (x, 0) || x1 != XEXP (x, 1))
++ 	{
++ 	  /* We can tolerate LO_SUMs being offset here; these
++ 	     rtl are used for nothing other than comparisons.  */
++ 	  if (GET_CODE (x0) == CONST_INT)
++ 	    return plus_constant_for_output (x1, INTVAL (x0));
++ 	  else if (GET_CODE (x1) == CONST_INT)
++ 	    return plus_constant_for_output (x0, INTVAL (x1));
++ 	  return gen_rtx (PLUS, GET_MODE (x), x0, x1);
++ 	}
++     }
++   /* This gives us much better alias analysis when called from
++      the loop optimizer.   Note we want to leave the original
++      MEM alone, but need to return the canonicalized MEM with
++      all the flags with their original values.  */
++   else if (GET_CODE (x) == MEM)
++     {
++       rtx addr = canon_rtx (XEXP (x, 0));
++       if (addr != XEXP (x, 0))
++ 	{
++ 	  rtx new = gen_rtx (MEM, GET_MODE (x), addr);
++ 	  MEM_VOLATILE_P (new) = MEM_VOLATILE_P (x);
++ 	  RTX_UNCHANGING_P (new) = RTX_UNCHANGING_P (x);
++ 	  MEM_IN_STRUCT_P (new) = MEM_IN_STRUCT_P (x);
++ 	  x = new;
++ 	}
++     }
++   return x;
++ }
++ 
++ /* Return 1 if X and Y are identical-looking rtx's.
++ 
++    We use the data in reg_known_value above to see if two registers with
++    different numbers are, in fact, equivalent.  */
++ 
++ static int
++ rtx_equal_for_memref_p (x, y)
++      rtx x, y;
++ {
++   register int i;
++   register int j;
++   register enum rtx_code code;
++   register char *fmt;
++ 
++   if (x == 0 && y == 0)
++     return 1;
++   if (x == 0 || y == 0)
++     return 0;
++   x = canon_rtx (x);
++   y = canon_rtx (y);
++ 
++   if (x == y)
++     return 1;
++ 
++   code = GET_CODE (x);
++   /* Rtx's of different codes cannot be equal.  */
++   if (code != GET_CODE (y))
++     return 0;
++ 
++   /* (MULT:SI x y) and (MULT:HI x y) are NOT equivalent.
++      (REG:SI x) and (REG:HI x) are NOT equivalent.  */
++ 
++   if (GET_MODE (x) != GET_MODE (y))
++     return 0;
++ 
++   /* REG, LABEL_REF, and SYMBOL_REF can be compared nonrecursively.  */
++ 
++   if (code == REG)
++     return REGNO (x) == REGNO (y);
++   if (code == LABEL_REF)
++     return XEXP (x, 0) == XEXP (y, 0);
++   if (code == SYMBOL_REF)
++     return XSTR (x, 0) == XSTR (y, 0);
++ 
++   /* For commutative operations, the RTX match if the operand match in any
++      order.  Also handle the simple binary and unary cases without a loop.  */
++   if (code == EQ || code == NE || GET_RTX_CLASS (code) == 'c')
++     return ((rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0))
++ 	     && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 1)))
++ 	    || (rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 1))
++ 		&& rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 0))));
++   else if (GET_RTX_CLASS (code) == '<' || GET_RTX_CLASS (code) == '2')
++     return (rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0))
++ 	    && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 1)));
++   else if (GET_RTX_CLASS (code) == '1')
++     return rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0));
++ 
++   /* Compare the elements.  If any pair of corresponding elements
++      fail to match, return 0 for the whole things.  */
++ 
++   fmt = GET_RTX_FORMAT (code);
++   for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--)
++     {
++       switch (fmt[i])
++ 	{
++ 	case 'w':
++ 	  if (XWINT (x, i) != XWINT (y, i))
++ 	    return 0;
++ 	  break;
++ 
++ 	case 'n':
++ 	case 'i':
++ 	  if (XINT (x, i) != XINT (y, i))
++ 	    return 0;
++ 	  break;
++ 
++ 	case 'V':
++ 	case 'E':
++ 	  /* Two vectors must have the same length.  */
++ 	  if (XVECLEN (x, i) != XVECLEN (y, i))
++ 	    return 0;
++ 
++ 	  /* And the corresponding elements must match.  */
++ 	  for (j = 0; j < XVECLEN (x, i); j++)
++ 	    if (rtx_equal_for_memref_p (XVECEXP (x, i, j), XVECEXP (y, i, j)) == 0)
++ 	      return 0;
++ 	  break;
++ 
++ 	case 'e':
++ 	  if (rtx_equal_for_memref_p (XEXP (x, i), XEXP (y, i)) == 0)
++ 	    return 0;
++ 	  break;
++ 
++ 	case 'S':
++ 	case 's':
++ 	  if (strcmp (XSTR (x, i), XSTR (y, i)))
++ 	    return 0;
++ 	  break;
++ 
++ 	case 'u':
++ 	  /* These are just backpointers, so they don't matter.  */
++ 	  break;
++ 
++ 	case '0':
++ 	  break;
++ 
++ 	  /* It is believed that rtx's at this level will never
++ 	     contain anything but integers and other rtx's,
++ 	     except for within LABEL_REFs and SYMBOL_REFs.  */
++ 	default:
++ 	  abort ();
++ 	}
++     }
++   return 1;
++ }
++ 
++ /* Given an rtx X, find a SYMBOL_REF or LABEL_REF within
++    X and return it, or return 0 if none found.  */
++ 
++ static rtx
++ find_symbolic_term (x)
++      rtx x;
++ {
++   register int i;
++   register enum rtx_code code;
++   register char *fmt;
++ 
++   code = GET_CODE (x);
++   if (code == SYMBOL_REF || code == LABEL_REF)
++     return x;
++   if (GET_RTX_CLASS (code) == 'o')
++     return 0;
++ 
++   fmt = GET_RTX_FORMAT (code);
++   for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--)
++     {
++       rtx t;
++ 
++       if (fmt[i] == 'e')
++ 	{
++ 	  t = find_symbolic_term (XEXP (x, i));
++ 	  if (t != 0)
++ 	    return t;
++ 	}
++       else if (fmt[i] == 'E')
++ 	break;
++     }
++   return 0;
++ }
++ 
++ static rtx
++ find_base_term (x)
++      register rtx x;
++ {
++   switch (GET_CODE (x))
++     {
++     case REG:
++       return REG_BASE_VALUE (x);
++ 
++     case HIGH:
++       return find_base_term (XEXP (x, 0));
++ 
++     case CONST:
++       x = XEXP (x, 0);
++       if (GET_CODE (x) != PLUS && GET_CODE (x) != MINUS)
++ 	return 0;
++       /* fall through */
++     case LO_SUM:
++     case PLUS:
++     case MINUS:
++       {
++ 	rtx tmp = find_base_term (XEXP (x, 0));
++ 	if (tmp)
++ 	  return tmp;
++ 	return find_base_term (XEXP (x, 1));
++       }
++ 
++     case AND:
++       if (GET_CODE (XEXP (x, 0)) == REG && GET_CODE (XEXP (x, 1)) == CONST_INT)
++ 	return REG_BASE_VALUE (XEXP (x, 0));
++       return 0;
++ 
++     case SYMBOL_REF:
++     case LABEL_REF:
++       return x;
++ 
++     default:
++       return 0;
++     }
++ }
++ 
++ /* Return 0 if the addresses X and Y are known to point to different
++    objects, 1 if they might be pointers to the same object.  */
++ 
++ static int
++ base_alias_check (x, y)
++      rtx x, y;
++ {
++   rtx x_base = find_base_term (x);
++   rtx y_base = find_base_term (y);
++ 
++   /* If either base address is unknown or the base addresses are equal,
++      nothing is known about aliasing.  */
++ 
++   if (x_base == 0 || y_base == 0 || rtx_equal_p (x_base, y_base))
++     return 1;
++ 
++   /* The base addresses of the read and write are different
++      expressions.  If they are both symbols there is no
++      conflict.  */
++   if (GET_CODE (x_base) != ADDRESS && GET_CODE (y_base) != ADDRESS)
++     return 0;
++ 
++   /* If one address is a stack reference there can be no alias:
++      stack references using different base registers do not alias,
++      a stack reference can not alias a parameter, and a stack reference
++      can not alias a global.  */
++   if ((GET_CODE (x_base) == ADDRESS && GET_MODE (x_base) == Pmode)
++       || (GET_CODE (y_base) == ADDRESS && GET_MODE (y_base) == Pmode))
++     return 0;
++ 
++   if (! flag_argument_noalias)
++     return 1;
++ 
++   if (flag_argument_noalias > 1)
++     return 0;
++ 
++   /* Weak noalias assertion (arguments are distinct, but may match globals). */
++   return ! (GET_MODE (x_base) == VOIDmode && GET_MODE (y_base) == VOIDmode);
++ }
++ 
++ /* Return nonzero if X and Y (memory addresses) could reference the
++    same location in memory.  C is an offset accumulator.  When
++    C is nonzero, we are testing aliases between X and Y + C.
++    XSIZE is the size in bytes of the X reference,
++    similarly YSIZE is the size in bytes for Y.
++ 
++    If XSIZE or YSIZE is zero, we do not know the amount of memory being
++    referenced (the reference was BLKmode), so make the most pessimistic
++    assumptions.
++ 
++    We recognize the following cases of non-conflicting memory:
++ 
++ 	(1) addresses involving the frame pointer cannot conflict
++ 	    with addresses involving static variables.
++ 	(2) static variables with different addresses cannot conflict.
++ 
++    Nice to notice that varying addresses cannot conflict with fp if no
++    local variables had their addresses taken, but that's too hard now.  */
++ 
++ 
++ static int
++ memrefs_conflict_p (xsize, x, ysize, y, c)
++      register rtx x, y;
++      int xsize, ysize;
++      HOST_WIDE_INT c;
++ {
++   if (GET_CODE (x) == HIGH)
++     x = XEXP (x, 0);
++   else if (GET_CODE (x) == LO_SUM)
++     x = XEXP (x, 1);
++   else
++     x = canon_rtx (x);
++   if (GET_CODE (y) == HIGH)
++     y = XEXP (y, 0);
++   else if (GET_CODE (y) == LO_SUM)
++     y = XEXP (y, 1);
++   else
++     y = canon_rtx (y);
++ 
++   if (rtx_equal_for_memref_p (x, y))
++     {
++       if (xsize == 0 || ysize == 0)
++ 	return 1;
++       if (c >= 0 && xsize > c)
++ 	return 1;
++       if (c < 0 && ysize+c > 0)
++ 	return 1;
++       return 0;
++     }
++ 
++   if (y == frame_pointer_rtx || y == hard_frame_pointer_rtx
++       || y == stack_pointer_rtx)
++     {
++       rtx t = y;
++       int tsize = ysize;
++       y = x; ysize = xsize;
++       x = t; xsize = tsize;
++     }
++ 
++   if (x == frame_pointer_rtx || x == hard_frame_pointer_rtx
++       || x == stack_pointer_rtx)
++     {
++       rtx y1;
++ 
++       if (CONSTANT_P (y))
++ 	return 0;
++ 
++       if (GET_CODE (y) == PLUS
++ 	  && canon_rtx (XEXP (y, 0)) == x
++ 	  && (y1 = canon_rtx (XEXP (y, 1)))
++ 	  && GET_CODE (y1) == CONST_INT)
++ 	{
++ 	  c += INTVAL (y1);
++ 	  return (xsize == 0 || ysize == 0
++ 		  || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0));
++ 	}
++ 
++       if (GET_CODE (y) == PLUS
++ 	  && (y1 = canon_rtx (XEXP (y, 0)))
++ 	  && CONSTANT_P (y1))
++ 	return 0;
++ 
++       return 1;
++     }
++ 
++   if (GET_CODE (x) == PLUS)
++     {
++       /* The fact that X is canonicalized means that this
++ 	 PLUS rtx is canonicalized.  */
++       rtx x0 = XEXP (x, 0);
++       rtx x1 = XEXP (x, 1);
++ 
++       if (GET_CODE (y) == PLUS)
++ 	{
++ 	  /* The fact that Y is canonicalized means that this
++ 	     PLUS rtx is canonicalized.  */
++ 	  rtx y0 = XEXP (y, 0);
++ 	  rtx y1 = XEXP (y, 1);
++ 
++ 	  if (rtx_equal_for_memref_p (x1, y1))
++ 	    return memrefs_conflict_p (xsize, x0, ysize, y0, c);
++ 	  if (rtx_equal_for_memref_p (x0, y0))
++ 	    return memrefs_conflict_p (xsize, x1, ysize, y1, c);
++ 	  if (GET_CODE (x1) == CONST_INT)
++ 	    if (GET_CODE (y1) == CONST_INT)
++ 	      return memrefs_conflict_p (xsize, x0, ysize, y0,
++ 					 c - INTVAL (x1) + INTVAL (y1));
++ 	    else
++ 	      return memrefs_conflict_p (xsize, x0, ysize, y, c - INTVAL (x1));
++ 	  else if (GET_CODE (y1) == CONST_INT)
++ 	    return memrefs_conflict_p (xsize, x, ysize, y0, c + INTVAL (y1));
++ 
++ 	  /* Handle case where we cannot understand iteration operators,
++ 	     but we notice that the base addresses are distinct objects.  */
++ 	  /* ??? Is this still necessary? */
++ 	  x = find_symbolic_term (x);
++ 	  if (x == 0)
++ 	    return 1;
++ 	  y = find_symbolic_term (y);
++ 	  if (y == 0)
++ 	    return 1;
++ 	  return rtx_equal_for_memref_p (x, y);
++ 	}
++       else if (GET_CODE (x1) == CONST_INT)
++ 	return memrefs_conflict_p (xsize, x0, ysize, y, c - INTVAL (x1));
++     }
++   else if (GET_CODE (y) == PLUS)
++     {
++       /* The fact that Y is canonicalized means that this
++ 	 PLUS rtx is canonicalized.  */
++       rtx y0 = XEXP (y, 0);
++       rtx y1 = XEXP (y, 1);
++ 
++       if (GET_CODE (y1) == CONST_INT)
++ 	return memrefs_conflict_p (xsize, x, ysize, y0, c + INTVAL (y1));
++       else
++ 	return 1;
++     }
++ 
++   if (GET_CODE (x) == GET_CODE (y))
++     switch (GET_CODE (x))
++       {
++       case MULT:
++ 	{
++ 	  /* Handle cases where we expect the second operands to be the
++ 	     same, and check only whether the first operand would conflict
++ 	     or not.  */
++ 	  rtx x0, y0;
++ 	  rtx x1 = canon_rtx (XEXP (x, 1));
++ 	  rtx y1 = canon_rtx (XEXP (y, 1));
++ 	  if (! rtx_equal_for_memref_p (x1, y1))
++ 	    return 1;
++ 	  x0 = canon_rtx (XEXP (x, 0));
++ 	  y0 = canon_rtx (XEXP (y, 0));
++ 	  if (rtx_equal_for_memref_p (x0, y0))
++ 	    return (xsize == 0 || ysize == 0
++ 		    || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0));
++ 
++ 	  /* Can't properly adjust our sizes.  */
++ 	  if (GET_CODE (x1) != CONST_INT)
++ 	    return 1;
++ 	  xsize /= INTVAL (x1);
++ 	  ysize /= INTVAL (x1);
++ 	  c /= INTVAL (x1);
++ 	  return memrefs_conflict_p (xsize, x0, ysize, y0, c);
++ 	}
++       }
++ 
++   /* Treat an access through an AND (e.g. a subword access on an Alpha)
++      as an access with indeterminate size.  */
++   if (GET_CODE (x) == AND && GET_CODE (XEXP (x, 1)) == CONST_INT)
++     return memrefs_conflict_p (0, XEXP (x, 0), ysize, y, c);
++   if (GET_CODE (y) == AND && GET_CODE (XEXP (y, 1)) == CONST_INT)
++     return memrefs_conflict_p (xsize, x, 0, XEXP (y, 0), c);
++ 
++   if (CONSTANT_P (x))
++     {
++       if (GET_CODE (x) == CONST_INT && GET_CODE (y) == CONST_INT)
++ 	{
++ 	  c += (INTVAL (y) - INTVAL (x));
++ 	  return (xsize == 0 || ysize == 0
++ 		  || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0));
++ 	}
++ 
++       if (GET_CODE (x) == CONST)
++ 	{
++ 	  if (GET_CODE (y) == CONST)
++ 	    return memrefs_conflict_p (xsize, canon_rtx (XEXP (x, 0)),
++ 				       ysize, canon_rtx (XEXP (y, 0)), c);
++ 	  else
++ 	    return memrefs_conflict_p (xsize, canon_rtx (XEXP (x, 0)),
++ 				       ysize, y, c);
++ 	}
++       if (GET_CODE (y) == CONST)
++ 	return memrefs_conflict_p (xsize, x, ysize,
++ 				   canon_rtx (XEXP (y, 0)), c);
++ 
++       if (CONSTANT_P (y))
++ 	return (rtx_equal_for_memref_p (x, y)
++ 		&& (xsize == 0 || ysize == 0
++ 		    || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0)));
++ 
++       return 1;
++     }
++   return 1;
++ }
++ 
++ /* Functions to compute memory dependencies.
++ 
++    Since we process the insns in execution order, we can build tables
++    to keep track of what registers are fixed (and not aliased), what registers
++    are varying in known ways, and what registers are varying in unknown
++    ways.
++ 
++    If both memory references are volatile, then there must always be a
++    dependence between the two references, since their order can not be
++    changed.  A volatile and non-volatile reference can be interchanged
++    though. 
++ 
++    A MEM_IN_STRUCT reference at a non-QImode varying address can never
++    conflict with a non-MEM_IN_STRUCT reference at a fixed address.   We must
++    allow QImode aliasing because the ANSI C standard allows character
++    pointers to alias anything.  We are assuming that characters are
++    always QImode here.  */
++ 
++ /* Read dependence: X is read after read in MEM takes place.  There can
++    only be a dependence here if both reads are volatile.  */
++ 
++ int
++ read_dependence (mem, x)
++      rtx mem;
++      rtx x;
++ {
++   return MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem);
++ }
++ 
++ /* True dependence: X is read after store in MEM takes place.  */
++ 
++ int
++ true_dependence (mem, mem_mode, x, varies)
++      rtx mem;
++      enum machine_mode mem_mode;
++      rtx x;
++      int (*varies)();
++ {
++   rtx x_addr, mem_addr;
++ 
++   if (MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem))
++     return 1;
++ 
++   x_addr = XEXP (x, 0);
++   mem_addr = XEXP (mem, 0);
++ 
++   if (flag_alias_check && ! base_alias_check (x_addr, mem_addr))
++     return 0;
++ 
++   /* If X is an unchanging read, then it can't possibly conflict with any
++      non-unchanging store.  It may conflict with an unchanging write though,
++      because there may be a single store to this address to initialize it.
++      Just fall through to the code below to resolve the case where we have
++      both an unchanging read and an unchanging write.  This won't handle all
++      cases optimally, but the possible performance loss should be
++      negligible.  */
++   if (RTX_UNCHANGING_P (x) && ! RTX_UNCHANGING_P (mem))
++     return 0;
++ 
++   x_addr = canon_rtx (x_addr);
++   mem_addr = canon_rtx (mem_addr);
++   if (mem_mode == VOIDmode)
++     mem_mode = GET_MODE (mem);
++ 
++   if (! memrefs_conflict_p (mem_mode, mem_addr, SIZE_FOR_MODE (x), x_addr, 0))
++     return 0;
++ 
++   /* If both references are struct references, or both are not, nothing
++      is known about aliasing.
++ 
++      If either reference is QImode or BLKmode, ANSI C permits aliasing.
++ 
++      If both addresses are constant, or both are not, nothing is known
++      about aliasing.  */
++   if (MEM_IN_STRUCT_P (x) == MEM_IN_STRUCT_P (mem)
++       || mem_mode == QImode || mem_mode == BLKmode
++       || GET_MODE (x) == QImode || GET_MODE (mem) == BLKmode
++       || varies (x_addr) == varies (mem_addr))
++     return 1;
++ 
++   /* One memory reference is to a constant address, one is not.
++      One is to a structure, the other is not.
++ 
++      If either memory reference is a variable structure the other is a
++      fixed scalar and there is no aliasing.  */
++   if ((MEM_IN_STRUCT_P (mem) && varies (mem_addr))
++       || (MEM_IN_STRUCT_P (x) && varies (x)))
++     return 0;
++ 
++   return 1;
++ }
++ 
++ /* Anti dependence: X is written after read in MEM takes place.  */
++ 
++ int
++ anti_dependence (mem, x)
++      rtx mem;
++      rtx x;
++ {
++   if (MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem))
++     return 1;
++ 
++   if (flag_alias_check && ! base_alias_check (XEXP (x, 0), XEXP (mem, 0)))
++     return 0;
++ 
++   /* If MEM is an unchanging read, then it can't possibly conflict with
++      the store to X, because there is at most one store to MEM, and it must
++      have occurred somewhere before MEM.  */
++   x = canon_rtx (x);
++   mem = canon_rtx (mem);
++   if (RTX_UNCHANGING_P (mem))
++     return 0;
++ 
++   return (memrefs_conflict_p (SIZE_FOR_MODE (mem), XEXP (mem, 0),
++ 			      SIZE_FOR_MODE (x), XEXP (x, 0), 0)
++ 	  && ! (MEM_IN_STRUCT_P (mem) && rtx_addr_varies_p (mem)
++ 		&& GET_MODE (mem) != QImode
++ 		&& ! MEM_IN_STRUCT_P (x) && ! rtx_addr_varies_p (x))
++ 	  && ! (MEM_IN_STRUCT_P (x) && rtx_addr_varies_p (x)
++ 		&& GET_MODE (x) != QImode
++ 		&& ! MEM_IN_STRUCT_P (mem) && ! rtx_addr_varies_p (mem)));
++ }
++ 
++ /* Output dependence: X is written after store in MEM takes place.  */
++ 
++ int
++ output_dependence (mem, x)
++      register rtx mem;
++      register rtx x;
++ {
++   if (MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem))
++     return 1;
++ 
++   if (flag_alias_check && !base_alias_check (XEXP (x, 0), XEXP (mem, 0)))
++     return 0;
++ 
++   x = canon_rtx (x);
++   mem = canon_rtx (mem);
++   return (memrefs_conflict_p (SIZE_FOR_MODE (mem), XEXP (mem, 0),
++ 			      SIZE_FOR_MODE (x), XEXP (x, 0), 0)
++ 	  && ! (MEM_IN_STRUCT_P (mem) && rtx_addr_varies_p (mem)
++ 		&& GET_MODE (mem) != QImode
++ 		&& ! MEM_IN_STRUCT_P (x) && ! rtx_addr_varies_p (x))
++ 	  && ! (MEM_IN_STRUCT_P (x) && rtx_addr_varies_p (x)
++ 		&& GET_MODE (x) != QImode
++ 		&& ! MEM_IN_STRUCT_P (mem) && ! rtx_addr_varies_p (mem)));
++ }
++ 
++ void
++ init_alias_analysis ()
++ {
++   int maxreg = max_reg_num ();
++   int changed;
++   register int i;
++   register rtx insn;
++   rtx note;
++   rtx set;
++ 
++   reg_known_value_size = maxreg;
++ 
++   reg_known_value
++     = (rtx *) oballoc ((maxreg - FIRST_PSEUDO_REGISTER) * sizeof (rtx))
++     - FIRST_PSEUDO_REGISTER;
++   reg_known_equiv_p =
++     oballoc (maxreg - FIRST_PSEUDO_REGISTER) - FIRST_PSEUDO_REGISTER;
++   bzero ((char *) (reg_known_value + FIRST_PSEUDO_REGISTER),
++ 	 (maxreg-FIRST_PSEUDO_REGISTER) * sizeof (rtx));
++   bzero (reg_known_equiv_p + FIRST_PSEUDO_REGISTER,
++ 	 (maxreg - FIRST_PSEUDO_REGISTER) * sizeof (char));
++ 
++   if (flag_alias_check)
++     {
++       /* Overallocate reg_base_value to allow some growth during loop
++ 	 optimization.  Loop unrolling can create a large number of
++ 	 registers.  */
++       reg_base_value_size = maxreg * 2;
++       reg_base_value = (rtx *)oballoc (reg_base_value_size * sizeof (rtx));
++       reg_seen = (char *)alloca (reg_base_value_size);
++       bzero (reg_base_value, reg_base_value_size * sizeof (rtx));
++       bzero (reg_seen, reg_base_value_size);
++ 
++       /* Mark all hard registers which may contain an address.
++ 	 The stack, frame and argument pointers may contain an address.
++ 	 An argument register which can hold a Pmode value may contain
++ 	 an address even if it is not in BASE_REGS.
++ 
++ 	 The address expression is VOIDmode for an argument and
++ 	 Pmode for other registers.  */
++ #ifndef OUTGOING_REGNO
++ #define OUTGOING_REGNO(N) N
++ #endif
++       for (i = 0; i < FIRST_PSEUDO_REGISTER; i++)
++ 	/* Check whether this register can hold an incoming pointer
++ 	   argument.  FUNCTION_ARG_REGNO_P tests outgoing register
++ 	   numbers, so translate if necessary due to register windows. */
++ 	if (FUNCTION_ARG_REGNO_P (OUTGOING_REGNO (i)) && HARD_REGNO_MODE_OK (i, Pmode))
++ 	  reg_base_value[i] = gen_rtx (ADDRESS, VOIDmode,
++ 				       gen_rtx (REG, Pmode, i));
++ 
++       reg_base_value[STACK_POINTER_REGNUM]
++ 	= gen_rtx (ADDRESS, Pmode, stack_pointer_rtx);
++       reg_base_value[ARG_POINTER_REGNUM]
++ 	= gen_rtx (ADDRESS, Pmode, arg_pointer_rtx);
++       reg_base_value[FRAME_POINTER_REGNUM]
++ 	= gen_rtx (ADDRESS, Pmode, frame_pointer_rtx);
++       reg_base_value[HARD_FRAME_POINTER_REGNUM]
++ 	= gen_rtx (ADDRESS, Pmode, hard_frame_pointer_rtx);
++     }
++ 
++   copying_arguments = 1;
++   /* Fill in the entries with known constant values.  */
++   for (insn = get_insns (); insn; insn = NEXT_INSN (insn))
++     {
++       if (flag_alias_check && GET_RTX_CLASS (GET_CODE (insn)) == 'i')
++ 	{
++ 	  /* If this insn has a noalias note, process it,  Otherwise,
++ 	     scan for sets.  A simple set will have no side effects
++ 	     which could change the base value of any other register. */
++ 	  rtx noalias_note;
++ 	  if (GET_CODE (PATTERN (insn)) == SET
++ 	      && (noalias_note = find_reg_note (insn, REG_NOALIAS, NULL_RTX)))
++ 	      record_set (SET_DEST (PATTERN (insn)), 0);
++ 	  else
++ 	    note_stores (PATTERN (insn), record_set);
++ 	}
++       else if (GET_CODE (insn) == NOTE
++ 	       && NOTE_LINE_NUMBER (insn) == NOTE_INSN_FUNCTION_BEG)
++ 	copying_arguments = 0;
++ 
++       if ((set = single_set (insn)) != 0
++ 	  && GET_CODE (SET_DEST (set)) == REG
++ 	  && REGNO (SET_DEST (set)) >= FIRST_PSEUDO_REGISTER
++ 	  && (((note = find_reg_note (insn, REG_EQUAL, 0)) != 0
++ 	       && reg_n_sets[REGNO (SET_DEST (set))] == 1)
++ 	      || (note = find_reg_note (insn, REG_EQUIV, NULL_RTX)) != 0)
++ 	  && GET_CODE (XEXP (note, 0)) != EXPR_LIST)
++ 	{
++ 	  int regno = REGNO (SET_DEST (set));
++ 	  reg_known_value[regno] = XEXP (note, 0);
++ 	  reg_known_equiv_p[regno] = REG_NOTE_KIND (note) == REG_EQUIV;
++ 	}
++     }
++ 
++   /* Fill in the remaining entries.  */
++   for (i = FIRST_PSEUDO_REGISTER; i < maxreg; i++)
++     if (reg_known_value[i] == 0)
++       reg_known_value[i] = regno_reg_rtx[i];
++ 
++   if (! flag_alias_check)
++     return;
++ 
++   /* Simplify the reg_base_value array so that no register refers to
++      another register, except to special registers indirectly through
++      ADDRESS expressions.
++ 
++      In theory this loop can take as long as O(registers^2), but unless
++      there are very long dependency chains it will run in close to linear
++      time.  */
++   do
++     {
++       changed = 0;
++       for (i = FIRST_PSEUDO_REGISTER; i < reg_base_value_size; i++)
++ 	{
++ 	  rtx base = reg_base_value[i];
++ 	  if (base && GET_CODE (base) == REG)
++ 	    {
++ 	      int base_regno = REGNO (base);
++ 	      if (base_regno == i)		/* register set from itself */
++ 		reg_base_value[i] = 0;
++ 	      else
++ 		reg_base_value[i] = reg_base_value[base_regno];
++ 	      changed = 1;
++ 	    }
++ 	}
++     }
++   while (changed);
++ 
++   reg_seen = 0;
++ }
++ 
++ void
++ end_alias_analysis ()
++ {
++   reg_known_value = 0;
++   reg_base_value = 0;
++   reg_base_value_size = 0;
++ }
+diff -rcp2N gcc-2.7.2.2/c-decl.c g77-new/c-decl.c
+*** gcc-2.7.2.2/c-decl.c	Fri Oct 27 05:44:43 1995
+--- g77-new/c-decl.c	Sun Aug 10 18:46:24 1997
+*************** init_decl_processing ()
+*** 3207,3210 ****
+--- 3207,3223 ----
+    builtin_function ("__builtin_cosl", ldouble_ftype_ldouble, 
+  		    BUILT_IN_COS, "cosl");
++   builtin_function ("__builtin_setjmp",
++ 		    build_function_type (integer_type_node,
++ 					 tree_cons (NULL_TREE,
++ 						    ptr_type_node, endlink)),
++ 		    BUILT_IN_SETJMP, NULL_PTR);
++   builtin_function ("__builtin_longjmp",
++ 		    build_function_type
++ 		    (void_type_node,
++ 		     tree_cons (NULL, ptr_type_node,
++ 				tree_cons (NULL_TREE,
++ 					   integer_type_node,
++ 					   endlink))),
++ 		    BUILT_IN_LONGJMP, NULL_PTR);
+  
+    /* In an ANSI C program, it is okay to supply built-in meanings
+*************** grokdeclarator (declarator, declspecs, d
+*** 4049,4052 ****
+--- 4062,4066 ----
+    int volatilep;
+    int inlinep;
++   int restrictp;
+    int explicit_int = 0;
+    int explicit_char = 0;
+*************** grokdeclarator (declarator, declspecs, d
+*** 4342,4349 ****
+--- 4356,4366 ----
+    volatilep = !! (specbits & 1 << (int) RID_VOLATILE) + TYPE_VOLATILE (type);
+    inlinep = !! (specbits & (1 << (int) RID_INLINE));
++   restrictp = !! (specbits & (1 << (int) RID_RESTRICT));
+    if (constp > 1)
+      pedwarn ("duplicate `const'");
+    if (volatilep > 1)
+      pedwarn ("duplicate `volatile'");
++   if (restrictp)
++     error ("`restrict' used in non-parameter or non-pointer type declaration");
+    if (! flag_gen_aux_info && (TYPE_READONLY (type) || TYPE_VOLATILE (type)))
+      type = TYPE_MAIN_VARIANT (type);
+*************** grokdeclarator (declarator, declspecs, d
+*** 4693,4696 ****
+--- 4710,4715 ----
+  		  else if (TREE_VALUE (typemodlist) == ridpointers[(int) RID_VOLATILE])
+  		    volatilep++;
++ 		  else if (TREE_VALUE (typemodlist) == ridpointers[(int) RID_RESTRICT])
++ 		    restrictp++;
+  		  else if (!erred)
+  		    {
+*************** grokdeclarator (declarator, declspecs, d
+*** 4703,4706 ****
+--- 4722,4727 ----
+  	      if (volatilep > 1)
+  		pedwarn ("duplicate `volatile'");
++ 	      if (restrictp > 1)
++ 		pedwarn ("duplicate `restrict'");
+  	    }
+  
+*************** grokdeclarator (declarator, declspecs, d
+*** 4844,4847 ****
+--- 4865,4875 ----
+  	  }
+  
++ 	if (restrictp)
++ 	  {
++ 	    if (TREE_CODE (TREE_TYPE (decl)) != POINTER_TYPE)
++ 	      error ("`restrict' applied to non-pointer");
++ 	    DECL_RESTRICT (decl) = 1;
++ 	  }
++ 
+  	DECL_ARG_TYPE_AS_WRITTEN (decl) = type_as_written;
+        }
+*************** start_struct (code, name)
+*** 5365,5368 ****
+--- 5393,5397 ----
+    pushtag (name, ref);
+    C_TYPE_BEING_DEFINED (ref) = 1;
++   TYPE_PACKED (ref) = flag_pack_struct;
+    return ref;
+  }
+*************** start_enum (name)
+*** 5806,5809 ****
+--- 5835,5841 ----
+    enum_overflow = 0;
+  
++   if (flag_short_enums)
++     TYPE_PACKED (enumtype) = 1;
++ 
+    return enumtype;
+  }
+*************** finish_enum (enumtype, values, attribute
+*** 5862,5867 ****
+    precision = MAX (lowprec, highprec);
+  
+!   if (flag_short_enums || TYPE_PACKED (enumtype)
+!       || precision > TYPE_PRECISION (integer_type_node))
+      /* Use the width of the narrowest normal C type which is wide enough.  */
+      TYPE_PRECISION (enumtype) = TYPE_PRECISION (type_for_size (precision, 1));
+--- 5894,5898 ----
+    precision = MAX (lowprec, highprec);
+  
+!   if (TYPE_PACKED (enumtype) || precision > TYPE_PRECISION (integer_type_node))
+      /* Use the width of the narrowest normal C type which is wide enough.  */
+      TYPE_PRECISION (enumtype) = TYPE_PRECISION (type_for_size (precision, 1));
+diff -rcp2N gcc-2.7.2.2/c-gperf.h g77-new/c-gperf.h
+*** gcc-2.7.2.2/c-gperf.h	Fri Mar  4 14:15:53 1994
+--- g77-new/c-gperf.h	Mon Aug 11 02:58:47 1997
+***************
+*** 1,15 ****
+  /* C code produced by gperf version 2.5 (GNU C++ version) */
+! /* Command-line: gperf -p -j1 -i 1 -g -o -t -G -N is_reserved_word -k1,3,$ c-parse.gperf  */
+  struct resword { char *name; short token; enum rid rid; };
+  
+! #define TOTAL_KEYWORDS 79
+  #define MIN_WORD_LENGTH 2
+  #define MAX_WORD_LENGTH 20
+! #define MIN_HASH_VALUE 10
+! #define MAX_HASH_VALUE 144
+! /* maximum key range = 135, duplicates = 0 */
+  
+  #ifdef __GNUC__
+! __inline
+  #endif
+  static unsigned int
+--- 1,16 ----
+  /* C code produced by gperf version 2.5 (GNU C++ version) */
+! /* Command-line: gperf -p -j1 -i 1 -g -o -t -G -N is_reserved_word -k1,3,$ ../g77-new/c-parse.gperf  */
+! /* Command-line: gperf -p -j1 -i 1 -g -o -t -N is_reserved_word -k1,3,$ c-parse.gperf  */ 
+  struct resword { char *name; short token; enum rid rid; };
+  
+! #define TOTAL_KEYWORDS 81
+  #define MIN_WORD_LENGTH 2
+  #define MAX_WORD_LENGTH 20
+! #define MIN_HASH_VALUE 11
+! #define MAX_HASH_VALUE 157
+! /* maximum key range = 147, duplicates = 0 */
+  
+  #ifdef __GNUC__
+! inline
+  #endif
+  static unsigned int
+*************** hash (str, len)
+*** 20,36 ****
+    static unsigned char asso_values[] =
+      {
+!      145, 145, 145, 145, 145, 145, 145, 145, 145, 145,
+!      145, 145, 145, 145, 145, 145, 145, 145, 145, 145,
+!      145, 145, 145, 145, 145, 145, 145, 145, 145, 145,
+!      145, 145, 145, 145, 145, 145, 145, 145, 145, 145,
+!      145, 145, 145, 145, 145, 145, 145, 145, 145, 145,
+!      145, 145, 145, 145, 145, 145, 145, 145, 145, 145,
+!      145, 145, 145, 145,  25, 145, 145, 145, 145, 145,
+!      145, 145, 145, 145, 145, 145, 145, 145, 145, 145,
+!      145, 145, 145, 145, 145, 145, 145, 145, 145, 145,
+!      145, 145, 145, 145, 145,   1, 145,  46,   8,  15,
+!       61,   6,  36,  48,   3,   5, 145,  18,  63,  25,
+!       29,  76,   1, 145,  13,   2,   1,  51,  37,   9,
+!        9,   1,   3, 145, 145, 145, 145, 145,
+      };
+    register int hval = len;
+--- 21,37 ----
+    static unsigned char asso_values[] =
+      {
+!      158, 158, 158, 158, 158, 158, 158, 158, 158, 158,
+!      158, 158, 158, 158, 158, 158, 158, 158, 158, 158,
+!      158, 158, 158, 158, 158, 158, 158, 158, 158, 158,
+!      158, 158, 158, 158, 158, 158, 158, 158, 158, 158,
+!      158, 158, 158, 158, 158, 158, 158, 158, 158, 158,
+!      158, 158, 158, 158, 158, 158, 158, 158, 158, 158,
+!      158, 158, 158, 158,   2, 158, 158, 158, 158, 158,
+!      158, 158, 158, 158, 158, 158, 158, 158, 158, 158,
+!      158, 158, 158, 158, 158, 158, 158, 158, 158, 158,
+!      158, 158, 158, 158, 158,   1, 158,  18,   1,  58,
+!       56,   6,  44,  64,  13,  45, 158,   4,  26,  68,
+!        2,  74,   1, 158,   2,  13,   1,  33,  48,   5,
+!        5,   3,  12, 158, 158, 158, 158, 158,
+      };
+    register int hval = len;
+*************** hash (str, len)
+*** 44,47 ****
+--- 45,49 ----
+        case 1:
+          hval += asso_values[str[0]];
++         break;
+      }
+    return hval + asso_values[str[len - 1]];
+*************** hash (str, len)
+*** 50,166 ****
+  static struct resword wordlist[] =
+  {
+!   {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, 
+!   {"",}, 
+!   {"int",  TYPESPEC, RID_INT},
+!   {"",}, {"",}, 
+!   {"__typeof__",  TYPEOF, NORID},
+!   {"__signed__",  TYPESPEC, RID_SIGNED},
+!   {"__imag__",  IMAGPART, NORID},
+!   {"switch",  SWITCH, NORID},
+!   {"__inline__",  SCSPEC, RID_INLINE},
+!   {"else",  ELSE, NORID},
+!   {"__iterator__",  SCSPEC, RID_ITERATOR},
+!   {"__inline",  SCSPEC, RID_INLINE},
+!   {"__extension__",  EXTENSION, NORID},
+!   {"struct",  STRUCT, NORID},
+!   {"__real__",  REALPART, NORID},
+!   {"__const",  TYPE_QUAL, RID_CONST},
+!   {"while",  WHILE, NORID},
+!   {"__const__",  TYPE_QUAL, RID_CONST},
+!   {"case",  CASE, NORID},
+!   {"__complex__",  TYPESPEC, RID_COMPLEX},
+!   {"__iterator",  SCSPEC, RID_ITERATOR},
+!   {"bycopy",  TYPE_QUAL, RID_BYCOPY},
+!   {"",}, {"",}, {"",}, 
+!   {"__complex",  TYPESPEC, RID_COMPLEX},
+!   {"",}, 
+!   {"in",  TYPE_QUAL, RID_IN},
+!   {"break",  BREAK, NORID},
+!   {"@defs",  DEFS, NORID},
+!   {"",}, {"",}, {"",}, 
+!   {"extern",  SCSPEC, RID_EXTERN},
+!   {"if",  IF, NORID},
+!   {"typeof",  TYPEOF, NORID},
+!   {"typedef",  SCSPEC, RID_TYPEDEF},
+!   {"__typeof",  TYPEOF, NORID},
+!   {"sizeof",  SIZEOF, NORID},
+!   {"",}, 
+!   {"return",  RETURN, NORID},
+!   {"const",  TYPE_QUAL, RID_CONST},
+!   {"__volatile__",  TYPE_QUAL, RID_VOLATILE},
+!   {"@private",  PRIVATE, NORID},
+!   {"@selector",  SELECTOR, NORID},
+!   {"__volatile",  TYPE_QUAL, RID_VOLATILE},
+!   {"__asm__",  ASM_KEYWORD, NORID},
+!   {"",}, {"",}, 
+!   {"continue",  CONTINUE, NORID},
+!   {"__alignof__",  ALIGNOF, NORID},
+!   {"__imag",  IMAGPART, NORID},
+!   {"__attribute__",  ATTRIBUTE, NORID},
+!   {"",}, {"",}, 
+!   {"__attribute",  ATTRIBUTE, NORID},
+!   {"for",  FOR, NORID},
+!   {"",}, 
+!   {"@encode",  ENCODE, NORID},
+!   {"id",  OBJECTNAME, RID_ID},
+!   {"static",  SCSPEC, RID_STATIC},
+!   {"@interface",  INTERFACE, NORID},
+!   {"",}, 
+!   {"__signed",  TYPESPEC, RID_SIGNED},
+!   {"",}, 
+!   {"__label__",  LABEL, NORID},
+!   {"",}, {"",}, 
+!   {"__asm",  ASM_KEYWORD, NORID},
+!   {"char",  TYPESPEC, RID_CHAR},
+!   {"",}, 
+!   {"inline",  SCSPEC, RID_INLINE},
+!   {"out",  TYPE_QUAL, RID_OUT},
+!   {"register",  SCSPEC, RID_REGISTER},
+!   {"__real",  REALPART, NORID},
+!   {"short",  TYPESPEC, RID_SHORT},
+!   {"",}, 
+!   {"enum",  ENUM, NORID},
+!   {"inout",  TYPE_QUAL, RID_INOUT},
+!   {"",}, 
+!   {"oneway",  TYPE_QUAL, RID_ONEWAY},
+!   {"union",  UNION, NORID},
+!   {"",}, 
+!   {"__alignof",  ALIGNOF, NORID},
+!   {"",}, 
+!   {"@implementation",  IMPLEMENTATION, NORID},
+!   {"",}, 
+!   {"@class",  CLASS, NORID},
+!   {"",}, 
+!   {"@public",  PUBLIC, NORID},
+!   {"asm",  ASM_KEYWORD, NORID},
+!   {"",}, {"",}, {"",}, {"",}, {"",}, 
+!   {"default",  DEFAULT, NORID},
+!   {"",}, 
+!   {"void",  TYPESPEC, RID_VOID},
+!   {"",}, 
+!   {"@protected",  PROTECTED, NORID},
+!   {"@protocol",  PROTOCOL, NORID},
+!   {"",}, {"",}, {"",}, 
+!   {"volatile",  TYPE_QUAL, RID_VOLATILE},
+!   {"",}, {"",}, 
+!   {"signed",  TYPESPEC, RID_SIGNED},
+!   {"float",  TYPESPEC, RID_FLOAT},
+!   {"@end",  END, NORID},
+!   {"",}, {"",}, 
+!   {"unsigned",  TYPESPEC, RID_UNSIGNED},
+!   {"@compatibility_alias",  ALIAS, NORID},
+!   {"double",  TYPESPEC, RID_DOUBLE},
+!   {"",}, {"",}, 
+!   {"auto",  SCSPEC, RID_AUTO},
+!   {"",}, 
+!   {"goto",  GOTO, NORID},
+!   {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, 
+!   {"do",  DO, NORID},
+!   {"",}, {"",}, {"",}, {"",}, 
+!   {"long",  TYPESPEC, RID_LONG},
+  };
+  
+  #ifdef __GNUC__
+! __inline
+  #endif
+  struct resword *
+--- 52,167 ----
+  static struct resword wordlist[] =
+  {
+!       {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, 
+!       {"",}, {"",}, 
+!       {"return",  RETURN, NORID},
+!       {"__real__",  REALPART, NORID},
+!       {"__typeof__",  TYPEOF, NORID},
+!       {"__restrict",  TYPE_QUAL, RID_RESTRICT},
+!       {"extern",  SCSPEC, RID_EXTERN},
+!       {"break",  BREAK, NORID},
+!       {"@encode",  ENCODE, NORID},
+!       {"@private",  PRIVATE, NORID},
+!       {"@selector",  SELECTOR, NORID},
+!       {"@interface",  INTERFACE, NORID},
+!       {"__extension__",  EXTENSION, NORID},
+!       {"struct",  STRUCT, NORID},
+!       {"",}, 
+!       {"restrict",  TYPE_QUAL, RID_RESTRICT},
+!       {"__signed__",  TYPESPEC, RID_SIGNED},
+!       {"@defs",  DEFS, NORID},
+!       {"__asm__",  ASM_KEYWORD, NORID},
+!       {"",}, 
+!       {"else",  ELSE, NORID},
+!       {"",}, 
+!       {"__alignof__",  ALIGNOF, NORID},
+!       {"",}, 
+!       {"__attribute__",  ATTRIBUTE, NORID},
+!       {"",}, 
+!       {"__real",  REALPART, NORID},
+!       {"__attribute",  ATTRIBUTE, NORID},
+!       {"__label__",  LABEL, NORID},
+!       {"",}, 
+!       {"@protocol",  PROTOCOL, NORID},
+!       {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, 
+!       {"@class",  CLASS, NORID},
+!       {"",}, 
+!       {"in",  TYPE_QUAL, RID_IN},
+!       {"int",  TYPESPEC, RID_INT},
+!       {"for",  FOR, NORID},
+!       {"typeof",  TYPEOF, NORID},
+!       {"typedef",  SCSPEC, RID_TYPEDEF},
+!       {"__typeof",  TYPEOF, NORID},
+!       {"__imag__",  IMAGPART, NORID},
+!       {"",}, 
+!       {"__inline__",  SCSPEC, RID_INLINE},
+!       {"__iterator",  SCSPEC, RID_ITERATOR},
+!       {"__iterator__",  SCSPEC, RID_ITERATOR},
+!       {"__inline",  SCSPEC, RID_INLINE},
+!       {"while",  WHILE, NORID},
+!       {"__volatile__",  TYPE_QUAL, RID_VOLATILE},
+!       {"",}, 
+!       {"@end",  END, NORID},
+!       {"__volatile",  TYPE_QUAL, RID_VOLATILE},
+!       {"const",  TYPE_QUAL, RID_CONST},
+!       {"__const",  TYPE_QUAL, RID_CONST},
+!       {"bycopy",  TYPE_QUAL, RID_BYCOPY},
+!       {"__const__",  TYPE_QUAL, RID_CONST},
+!       {"@protected",  PROTECTED, NORID},
+!       {"__complex__",  TYPESPEC, RID_COMPLEX},
+!       {"__alignof",  ALIGNOF, NORID},
+!       {"__complex",  TYPESPEC, RID_COMPLEX},
+!       {"continue",  CONTINUE, NORID},
+!       {"sizeof",  SIZEOF, NORID},
+!       {"register",  SCSPEC, RID_REGISTER},
+!       {"switch",  SWITCH, NORID},
+!       {"__signed",  TYPESPEC, RID_SIGNED},
+!       {"out",  TYPE_QUAL, RID_OUT},
+!       {"",}, 
+!       {"case",  CASE, NORID},
+!       {"char",  TYPESPEC, RID_CHAR},
+!       {"inline",  SCSPEC, RID_INLINE},
+!       {"",}, 
+!       {"union",  UNION, NORID},
+!       {"",}, 
+!       {"@implementation",  IMPLEMENTATION, NORID},
+!       {"volatile",  TYPE_QUAL, RID_VOLATILE},
+!       {"oneway",  TYPE_QUAL, RID_ONEWAY},
+!       {"",}, 
+!       {"if",  IF, NORID},
+!       {"__asm",  ASM_KEYWORD, NORID},
+!       {"short",  TYPESPEC, RID_SHORT},
+!       {"",}, 
+!       {"static",  SCSPEC, RID_STATIC},
+!       {"long",  TYPESPEC, RID_LONG},
+!       {"auto",  SCSPEC, RID_AUTO},
+!       {"",}, {"",}, 
+!       {"@public",  PUBLIC, NORID},
+!       {"double",  TYPESPEC, RID_DOUBLE},
+!       {"",}, 
+!       {"id",  OBJECTNAME, RID_ID},
+!       {"",}, {"",}, {"",}, {"",}, 
+!       {"default",  DEFAULT, NORID},
+!       {"@compatibility_alias",  ALIAS, NORID},
+!       {"unsigned",  TYPESPEC, RID_UNSIGNED},
+!       {"enum",  ENUM, NORID},
+!       {"",}, {"",}, {"",}, {"",}, 
+!       {"__imag",  IMAGPART, NORID},
+!       {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, 
+!       {"float",  TYPESPEC, RID_FLOAT},
+!       {"inout",  TYPE_QUAL, RID_INOUT},
+!       {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, 
+!       {"do",  DO, NORID},
+!       {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, 
+!       {"signed",  TYPESPEC, RID_SIGNED},
+!       {"",}, {"",}, {"",}, 
+!       {"goto",  GOTO, NORID},
+!       {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, 
+!       {"void",  TYPESPEC, RID_VOID},
+!       {"",}, {"",}, {"",}, 
+!       {"asm",  ASM_KEYWORD, NORID},
+  };
+  
+  #ifdef __GNUC__
+! inline
+  #endif
+  struct resword *
+diff -rcp2N gcc-2.7.2.2/c-lex.c g77-new/c-lex.c
+*** gcc-2.7.2.2/c-lex.c	Thu Jun 15 07:11:39 1995
+--- g77-new/c-lex.c	Sun Aug 10 18:46:49 1997
+*************** init_lex ()
+*** 173,176 ****
+--- 173,177 ----
+    ridpointers[(int) RID_CONST] = get_identifier ("const");
+    ridpointers[(int) RID_VOLATILE] = get_identifier ("volatile");
++   ridpointers[(int) RID_RESTRICT] = get_identifier ("restrict");
+    ridpointers[(int) RID_AUTO] = get_identifier ("auto");
+    ridpointers[(int) RID_STATIC] = get_identifier ("static");
+*************** init_lex ()
+*** 206,209 ****
+--- 207,211 ----
+        UNSET_RESERVED_WORD ("iterator");
+        UNSET_RESERVED_WORD ("complex");
++       UNSET_RESERVED_WORD ("restrict");
+      }
+    if (flag_no_asm)
+*************** init_lex ()
+*** 214,217 ****
+--- 216,220 ----
+        UNSET_RESERVED_WORD ("iterator");
+        UNSET_RESERVED_WORD ("complex");
++       UNSET_RESERVED_WORD ("restrict");
+      }
+  }
+*************** yylex ()
+*** 1433,1437 ****
+  	    /* Create a node with determined type and value.  */
+  	    if (imag)
+! 	      yylval.ttype = build_complex (convert (type, integer_zero_node),
+  					    build_real (type, value));
+  	    else
+--- 1436,1441 ----
+  	    /* Create a node with determined type and value.  */
+  	    if (imag)
+! 	      yylval.ttype = build_complex (NULL_TREE,
+! 					    convert (type, integer_zero_node),
+  					    build_real (type, value));
+  	    else
+*************** yylex ()
+*** 1624,1629 ****
+  		    <= TYPE_PRECISION (integer_type_node))
+  		  yylval.ttype
+! 		    = build_complex (integer_zero_node,
+! 				     convert (integer_type_node, yylval.ttype));
+  		else
+  		  error ("complex integer constant is too wide for `complex int'");
+--- 1628,1634 ----
+  		    <= TYPE_PRECISION (integer_type_node))
+  		  yylval.ttype
+! 		    = build_complex (NULL_TREE, integer_zero_node,
+! 				     convert (integer_type_node,
+! 					      yylval.ttype));
+  		else
+  		  error ("complex integer constant is too wide for `complex int'");
+diff -rcp2N gcc-2.7.2.2/c-lex.h g77-new/c-lex.h
+*** gcc-2.7.2.2/c-lex.h	Thu Jun 15 07:12:22 1995
+--- g77-new/c-lex.h	Sun Aug 10 18:10:55 1997
+*************** enum rid
+*** 43,47 ****
+    RID_VOLATILE,
+    RID_INLINE,
+!   RID_NOALIAS,
+    RID_ITERATOR,
+    RID_COMPLEX,
+--- 43,47 ----
+    RID_VOLATILE,
+    RID_INLINE,
+!   RID_RESTRICT,
+    RID_ITERATOR,
+    RID_COMPLEX,
+diff -rcp2N gcc-2.7.2.2/c-parse.gperf g77-new/c-parse.gperf
+*** gcc-2.7.2.2/c-parse.gperf	Fri Apr  9 19:00:44 1993
+--- g77-new/c-parse.gperf	Sun Aug 10 18:10:55 1997
+*************** __label__, LABEL, NORID
+*** 36,39 ****
+--- 36,40 ----
+  __real, REALPART, NORID
+  __real__, REALPART, NORID
++ __restrict, TYPE_QUAL, RID_RESTRICT
+  __signed, TYPESPEC, RID_SIGNED
+  __signed__, TYPESPEC, RID_SIGNED
+*************** oneway, TYPE_QUAL, RID_ONEWAY
+*** 69,72 ****
+--- 70,74 ----
+  out, TYPE_QUAL, RID_OUT
+  register, SCSPEC, RID_REGISTER
++ restrict, TYPE_QUAL, RID_RESTRICT
+  return, RETURN, NORID
+  short, TYPESPEC, RID_SHORT
+diff -rcp2N gcc-2.7.2.2/c-typeck.c g77-new/c-typeck.c
+*** gcc-2.7.2.2/c-typeck.c	Thu Feb 20 19:24:11 1997
+--- g77-new/c-typeck.c	Sun Aug 10 18:46:29 1997
+*************** pointer_int_sum (resultcode, ptrop, into
+*** 2681,2686 ****
+       so the multiply won't overflow spuriously.  */
+  
+!   if (TYPE_PRECISION (TREE_TYPE (intop)) != POINTER_SIZE)
+!     intop = convert (type_for_size (POINTER_SIZE, 0), intop);
+  
+    /* Replace the integer argument with a suitable product by the object size.
+--- 2681,2688 ----
+       so the multiply won't overflow spuriously.  */
+  
+!   if (TYPE_PRECISION (TREE_TYPE (intop)) != TYPE_PRECISION (sizetype)
+!       || TREE_UNSIGNED (TREE_TYPE (intop)) != TREE_UNSIGNED (sizetype))
+!     intop = convert (type_for_size (TYPE_PRECISION (sizetype), 
+! 				    TREE_UNSIGNED (sizetype)), intop);
+  
+    /* Replace the integer argument with a suitable product by the object size.
+diff -rcp2N gcc-2.7.2.2/calls.c g77-new/calls.c
+*** gcc-2.7.2.2/calls.c	Thu Oct 26 21:53:43 1995
+--- g77-new/calls.c	Sun Aug 10 18:46:16 1997
+*************** expand_call (exp, target, ignore)
+*** 564,567 ****
+--- 564,569 ----
+    /* Nonzero if it is plausible that this is a call to alloca.  */
+    int may_be_alloca;
++   /* Nonzero if this is a call to malloc or a related function. */
++   int is_malloc;
+    /* Nonzero if this is a call to setjmp or a related function.  */
+    int returns_twice;
+*************** expand_call (exp, target, ignore)
+*** 741,745 ****
+  	  if (stack_arg_under_construction || i >= 0)
+  	    {
+! 	      rtx insn = NEXT_INSN (before_call), seq;
+  
+  	      /* Look for a call in the inline function code.
+--- 743,749 ----
+  	  if (stack_arg_under_construction || i >= 0)
+  	    {
+! 	      rtx first_insn
+! 		= before_call ? NEXT_INSN (before_call) : get_insns ();
+! 	      rtx insn, seq;
+  
+  	      /* Look for a call in the inline function code.
+*************** expand_call (exp, target, ignore)
+*** 749,753 ****
+  
+  	      if (OUTGOING_ARGS_SIZE (DECL_SAVED_INSNS (fndecl)) == 0)
+! 		for (; insn; insn = NEXT_INSN (insn))
+  		  if (GET_CODE (insn) == CALL_INSN)
+  		    break;
+--- 753,757 ----
+  
+  	      if (OUTGOING_ARGS_SIZE (DECL_SAVED_INSNS (fndecl)) == 0)
+! 		for (insn = first_insn; insn; insn = NEXT_INSN (insn))
+  		  if (GET_CODE (insn) == CALL_INSN)
+  		    break;
+*************** expand_call (exp, target, ignore)
+*** 781,785 ****
+  		  seq = get_insns ();
+  		  end_sequence ();
+! 		  emit_insns_before (seq, NEXT_INSN (before_call));
+  		  emit_stack_restore (SAVE_BLOCK, old_stack_level, NULL_RTX);
+  		}
+--- 785,789 ----
+  		  seq = get_insns ();
+  		  end_sequence ();
+! 		  emit_insns_before (seq, first_insn);
+  		  emit_stack_restore (SAVE_BLOCK, old_stack_level, NULL_RTX);
+  		}
+*************** expand_call (exp, target, ignore)
+*** 852,855 ****
+--- 856,860 ----
+    returns_twice = 0;
+    is_longjmp = 0;
++   is_malloc = 0;
+  
+    if (name != 0 && IDENTIFIER_LENGTH (DECL_NAME (fndecl)) <= 15)
+*************** expand_call (exp, target, ignore)
+*** 891,894 ****
+--- 896,903 ----
+  	       && ! strcmp (tname, "longjmp"))
+  	is_longjmp = 1;
++       /* Only recognize malloc when alias analysis is enabled.  */
++       else if (tname[0] == 'm' && flag_alias_check
++ 	       && ! strcmp(tname, "malloc"))
++ 	is_malloc = 1;
+      }
+  
+*************** expand_call (exp, target, ignore)
+*** 1087,1090 ****
+--- 1096,1100 ----
+  
+  	      store_expr (args[i].tree_value, copy, 0);
++ 	      is_const = 0;
+  
+  	      args[i].tree_value = build1 (ADDR_EXPR,
+*************** expand_call (exp, target, ignore)
+*** 1363,1367 ****
+    /* Now we are about to start emitting insns that can be deleted
+       if a libcall is deleted.  */
+!   if (is_const)
+      start_sequence ();
+  
+--- 1373,1377 ----
+    /* Now we are about to start emitting insns that can be deleted
+       if a libcall is deleted.  */
+!   if (is_const || is_malloc)
+      start_sequence ();
+  
+*************** expand_call (exp, target, ignore)
+*** 1951,1954 ****
+--- 1961,1978 ----
+        end_sequence ();
+        emit_insns (insns);
++     }
++   else if (is_malloc)
++     {
++       rtx temp = gen_reg_rtx (GET_MODE (valreg));
++       rtx last, insns;
++ 
++       emit_move_insn (temp, valreg);
++       last = get_last_insn ();
++       REG_NOTES (last) = 
++ 	gen_rtx (EXPR_LIST, REG_NOALIAS, temp, REG_NOTES (last));
++       insns = get_insns ();
++       end_sequence ();
++       emit_insns (insns);
++       valreg = temp;
+      }
+  
+diff -rcp2N gcc-2.7.2.2/cccp.c g77-new/cccp.c
+*** gcc-2.7.2.2/cccp.c	Thu Oct 26 18:07:26 1995
+--- g77-new/cccp.c	Sun Aug 10 18:45:53 1997
+*************** initialize_builtins (inp, outp)
+*** 9626,9629 ****
+--- 9626,9630 ----
+      so that it is present only when truly compiling with GNU C.  */
+  /*  install ((U_CHAR *) "__GNUC__", -1, T_CONST, "2", -1);  */
++   install ((U_CHAR *) "__HAVE_BUILTIN_SETJMP__", -1, T_CONST, "1", -1);
+  
+    if (debug_output)
+diff -rcp2N gcc-2.7.2.2/combine.c g77-new/combine.c
+*** gcc-2.7.2.2/combine.c	Sun Nov 26 14:32:07 1995
+--- g77-new/combine.c	Mon Jul 28 21:44:17 1997
+*************** num_sign_bit_copies (x, mode)
+*** 7326,7329 ****
+--- 7326,7335 ----
+  
+      case NEG:
++       while (GET_MODE (XEXP (x, 0)) == GET_MODE (x)
++ 	     && GET_CODE (XEXP (x, 0)) == NEG
++ 	     && GET_MODE (XEXP (XEXP (x, 0), 0)) == GET_MODE (x)
++ 	     && GET_CODE (XEXP (XEXP (x, 0), 0)) == NEG)
++ 	x = XEXP (XEXP (x, 0), 0);	/* Speed up 961126-1.c */
++ 
+        /* In general, this subtracts one sign bit copy.  But if the value
+  	 is known to be positive, the number of sign bit copies is the
+*************** distribute_notes (notes, from_insn, i3, 
+*** 10648,10651 ****
+--- 10654,10658 ----
+  	case REG_EQUIV:
+  	case REG_NONNEG:
++ 	case REG_NOALIAS:
+  	  /* These notes say something about results of an insn.  We can
+  	     only support them if they used to be on I3 in which case they
+diff -rcp2N gcc-2.7.2.2/config/alpha/alpha.c g77-new/config/alpha/alpha.c
+*** gcc-2.7.2.2/config/alpha/alpha.c	Thu Feb 20 19:24:11 1997
+--- g77-new/config/alpha/alpha.c	Thu Jul 10 20:08:47 1997
+*************** direct_return ()
+*** 1239,1243 ****
+     cross-compiler.  Otherwise, use the versions in /usr/include/stamp.h.  */
+  
+! #if !defined(CROSS_COMPILE) && !defined(_WIN32)
+  #include <stamp.h>
+  #endif
+--- 1239,1243 ----
+     cross-compiler.  Otherwise, use the versions in /usr/include/stamp.h.  */
+  
+! #if !defined(CROSS_COMPILE) && !defined(_WIN32) && !defined(__linux__)
+  #include <stamp.h>
+  #endif
+*************** output_prolog (file, size)
+*** 1370,1373 ****
+--- 1370,1378 ----
+  
+    alpha_function_needs_gp = 0;
++ #ifdef __linux__
++   if(profile_flag) {
++       alpha_function_needs_gp = 1;
++   }
++ #endif
+    for (insn = get_insns (); insn; insn = NEXT_INSN (insn))
+      if ((GET_CODE (insn) == CALL_INSN)
+diff -rcp2N gcc-2.7.2.2/config/alpha/alpha.h g77-new/config/alpha/alpha.h
+*** gcc-2.7.2.2/config/alpha/alpha.h	Thu Feb 20 19:24:12 1997
+--- g77-new/config/alpha/alpha.h	Sun Aug 10 19:21:39 1997
+*************** extern int target_flags;
+*** 112,116 ****
+--- 112,118 ----
+      {"", TARGET_DEFAULT | TARGET_CPU_DEFAULT} }
+  
++ #ifndef TARGET_DEFAULT
+  #define TARGET_DEFAULT 3
++ #endif
+  
+  #ifndef TARGET_CPU_DEFAULT
+*************** extern int target_flags;
+*** 252,255 ****
+--- 254,260 ----
+  /* No data type wants to be aligned rounder than this.  */
+  #define BIGGEST_ALIGNMENT 64
++ 
++ /* For atomic access to objects, must have at least 32-bit alignment.  */
++ #define MINIMUM_ATOMIC_ALIGNMENT 32
+  
+  /* Make strings word-aligned so strcpy from constants will be faster.  */
+diff -rcp2N gcc-2.7.2.2/config/alpha/alpha.md g77-new/config/alpha/alpha.md
+*** gcc-2.7.2.2/config/alpha/alpha.md	Fri Oct 27 06:49:59 1995
+--- g77-new/config/alpha/alpha.md	Thu Jul 10 20:08:48 1997
+***************
+*** 1746,1752 ****
+  	(if_then_else:DF 
+  	 (match_operator 3 "signed_comparison_operator"
+! 			 [(match_operand:DF 1 "reg_or_fp0_operand" "fG,fG")
+  			  (match_operand:DF 2 "fp0_operand" "G,G")])
+! 	 (float_extend:DF (match_operand:SF 4 "reg_or_fp0_operand" "fG,0"))
+  	 (match_operand:DF 5 "reg_or_fp0_operand" "0,fG")))]
+    "TARGET_FP"
+--- 1746,1752 ----
+  	(if_then_else:DF 
+  	 (match_operator 3 "signed_comparison_operator"
+! 			 [(match_operand:DF 4 "reg_or_fp0_operand" "fG,fG")
+  			  (match_operand:DF 2 "fp0_operand" "G,G")])
+! 	 (float_extend:DF (match_operand:SF 1 "reg_or_fp0_operand" "fG,0"))
+  	 (match_operand:DF 5 "reg_or_fp0_operand" "0,fG")))]
+    "TARGET_FP"
+diff -rcp2N gcc-2.7.2.2/config/alpha/elf.h g77-new/config/alpha/elf.h
+*** gcc-2.7.2.2/config/alpha/elf.h	Wed Dec 31 19:00:00 1969
+--- g77-new/config/alpha/elf.h	Thu Jul 10 20:08:49 1997
+***************
+*** 0 ****
+--- 1,522 ----
++ /* Definitions of target machine for GNU compiler, for DEC Alpha w/ELF.
++    Copyright (C) 1996 Free Software Foundation, Inc.
++    Contributed by Richard Henderson (rth@tamu.edu).
++ 
++ This file is part of GNU CC.
++ 
++ GNU CC 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 CC 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 CC; see the file COPYING.  If not, write to
++ the Free Software Foundation, 59 Temple Place - Suite 330,
++ Boston, MA 02111-1307, USA.    */
++ 
++ /* This is used on Alpha platforms that use the ELF format.
++ Currently only Linux uses this. */
++ 
++ #include "alpha/linux.h"
++ 
++ #undef TARGET_VERSION
++ #define TARGET_VERSION fprintf (stderr, " (Alpha Linux/ELF)");
++ 
++ #undef OBJECT_FORMAT_COFF
++ #undef EXTENDED_COFF
++ #define OBJECT_FORMAT_ELF
++ 
++ #define SDB_DEBUGGING_INFO
++ 
++ #undef ASM_FINAL_SPEC
++ 
++ #undef CPP_PREDEFINES
++ #define CPP_PREDEFINES "\
++ -D__alpha -D__alpha__ -D__linux__ -D__linux -D_LONGLONG -Dlinux -Dunix \
++ -Asystem(linux) -Acpu(alpha) -Amachine(alpha) -D__ELF__"
++ 
++ #undef LINK_SPEC
++ #define LINK_SPEC "-m elf64alpha -G 8 %{O*:-O3} %{!O*:-O1}	\
++   %{shared:-shared}						\
++   %{!shared:							\
++     %{!static:							\
++       %{rdynamic:-export-dynamic}				\
++       %{!dynamic-linker:-dynamic-linker /lib/ld.so.1}}		\
++     %{static:-static}}"
++ 
++ /* Output at beginning of assembler file.  */
++ 
++ #undef ASM_FILE_START
++ #define ASM_FILE_START(FILE)					\
++ {								\
++   alpha_write_verstamp (FILE);					\
++   output_file_directive (FILE, main_input_filename);		\
++   fprintf (FILE, "\t.version\t\"01.01\"\n");			\
++   fprintf (FILE, "\t.set noat\n");				\
++ }
++ 
++ #define ASM_OUTPUT_SOURCE_LINE(STREAM, LINE)			\
++   alpha_output_lineno (STREAM, LINE)
++ extern void alpha_output_lineno ();
++ 
++ extern void output_file_directive ();
++ 
++ /* Attach a special .ident directive to the end of the file to identify
++    the version of GCC which compiled this code.  The format of the
++    .ident string is patterned after the ones produced by native svr4
++    C compilers.  */
++ 
++ #define IDENT_ASM_OP ".ident"
++ 
++ #ifdef IDENTIFY_WITH_IDENT
++ #define ASM_IDENTIFY_GCC(FILE) /* nothing */
++ #define ASM_IDENTIFY_LANGUAGE(FILE)				\
++  fprintf(FILE, "\t%s \"GCC (%s) %s\"\n", IDENT_ASM_OP,		\
++ 	 lang_identify(), version_string)
++ #else
++ #define ASM_FILE_END(FILE)					\
++ do {				 				\
++      fprintf ((FILE), "\t%s\t\"GCC: (GNU) %s\"\n",		\
++ 	      IDENT_ASM_OP, version_string);			\
++    } while (0)
++ #endif
++ 
++ /* Allow #sccs in preprocessor.  */
++ 
++ #define SCCS_DIRECTIVE
++ 
++ /* Output #ident as a .ident.  */
++ 
++ #define ASM_OUTPUT_IDENT(FILE, NAME) \
++   fprintf (FILE, "\t%s\t\"%s\"\n", IDENT_ASM_OP, NAME);
++ 
++ /* This is how to allocate empty space in some section.  The .zero
++    pseudo-op is used for this on most svr4 assemblers.  */
++ 
++ #define SKIP_ASM_OP	".zero"
++ 
++ #undef ASM_OUTPUT_SKIP
++ #define ASM_OUTPUT_SKIP(FILE,SIZE) \
++   fprintf (FILE, "\t%s\t%u\n", SKIP_ASM_OP, (SIZE))
++ 
++ /* Output the label which precedes a jumptable.  Note that for all svr4
++    systems where we actually generate jumptables (which is to say every
++    svr4 target except i386, where we use casesi instead) we put the jump-
++    tables into the .rodata section and since other stuff could have been
++    put into the .rodata section prior to any given jumptable, we have to
++    make sure that the location counter for the .rodata section gets pro-
++    perly re-aligned prior to the actual beginning of the jump table.  */
++ 
++ #define ALIGN_ASM_OP ".align"
++ 
++ #ifndef ASM_OUTPUT_BEFORE_CASE_LABEL
++ #define ASM_OUTPUT_BEFORE_CASE_LABEL(FILE,PREFIX,NUM,TABLE) \
++   ASM_OUTPUT_ALIGN ((FILE), 2);
++ #endif
++ 
++ #undef ASM_OUTPUT_CASE_LABEL
++ #define ASM_OUTPUT_CASE_LABEL(FILE,PREFIX,NUM,JUMPTABLE)		\
++   do {									\
++     ASM_OUTPUT_BEFORE_CASE_LABEL (FILE, PREFIX, NUM, JUMPTABLE)		\
++     ASM_OUTPUT_INTERNAL_LABEL (FILE, PREFIX, NUM);			\
++   } while (0)
++ 
++ /* The standard SVR4 assembler seems to require that certain builtin
++    library routines (e.g. .udiv) be explicitly declared as .globl
++    in each assembly file where they are referenced.  */
++ 
++ #define ASM_OUTPUT_EXTERNAL_LIBCALL(FILE, FUN)				\
++   ASM_GLOBALIZE_LABEL (FILE, XSTR (FUN, 0))
++ 
++ /* This says how to output assembler code to declare an
++    uninitialized external linkage data object.  Under SVR4,
++    the linker seems to want the alignment of data objects
++    to depend on their types.  We do exactly that here.  */
++ 
++ #define COMMON_ASM_OP	".comm"
++ 
++ #undef ASM_OUTPUT_ALIGNED_COMMON
++ #define ASM_OUTPUT_ALIGNED_COMMON(FILE, NAME, SIZE, ALIGN)		\
++ do {									\
++   fprintf ((FILE), "\t%s\t", COMMON_ASM_OP);				\
++   assemble_name ((FILE), (NAME));					\
++   fprintf ((FILE), ",%u,%u\n", (SIZE), (ALIGN) / BITS_PER_UNIT);	\
++ } while (0)
++ 
++ /* This says how to output assembler code to declare an
++    uninitialized internal linkage data object.  Under SVR4,
++    the linker seems to want the alignment of data objects
++    to depend on their types.  We do exactly that here.  */
++ 
++ #define LOCAL_ASM_OP	".local"
++ 
++ #undef ASM_OUTPUT_ALIGNED_LOCAL
++ #define ASM_OUTPUT_ALIGNED_LOCAL(FILE, NAME, SIZE, ALIGN)		\
++ do {									\
++   fprintf ((FILE), "\t%s\t", LOCAL_ASM_OP);				\
++   assemble_name ((FILE), (NAME));					\
++   fprintf ((FILE), "\n");						\
++   ASM_OUTPUT_ALIGNED_COMMON (FILE, NAME, SIZE, ALIGN);			\
++ } while (0)
++ 
++ /* This is the pseudo-op used to generate a 64-bit word of data with a
++    specific value in some section.    */
++ 
++ #define INT_ASM_OP		".quad"
++ 
++ /* This is the pseudo-op used to generate a contiguous sequence of byte
++    values from a double-quoted string WITHOUT HAVING A TERMINATING NUL
++    AUTOMATICALLY APPENDED.  This is the same for most svr4 assemblers.  */
++ 
++ #undef ASCII_DATA_ASM_OP
++ #define ASCII_DATA_ASM_OP	".ascii"
++ 
++ /* Support const sections and the ctors and dtors sections for g++.
++    Note that there appears to be two different ways to support const
++    sections at the moment.  You can either #define the symbol
++    READONLY_DATA_SECTION (giving it some code which switches to the
++    readonly data section) or else you can #define the symbols
++    EXTRA_SECTIONS, EXTRA_SECTION_FUNCTIONS, SELECT_SECTION, and
++    SELECT_RTX_SECTION.  We do both here just to be on the safe side.  */
++ 
++ #define USE_CONST_SECTION	1
++ 
++ #define CONST_SECTION_ASM_OP	".section\t.rodata"
++ 
++ /* Define the pseudo-ops used to switch to the .ctors and .dtors sections.
++ 
++    Note that we want to give these sections the SHF_WRITE attribute
++    because these sections will actually contain data (i.e. tables of
++    addresses of functions in the current root executable or shared library
++    file) and, in the case of a shared library, the relocatable addresses
++    will have to be properly resolved/relocated (and then written into) by
++    the dynamic linker when it actually attaches the given shared library
++    to the executing process.  (Note that on SVR4, you may wish to use the
++    `-z text' option to the ELF linker, when building a shared library, as
++    an additional check that you are doing everything right.  But if you do
++    use the `-z text' option when building a shared library, you will get
++    errors unless the .ctors and .dtors sections are marked as writable
++    via the SHF_WRITE attribute.)  */
++ 
++ #define CTORS_SECTION_ASM_OP	".section\t.ctors,\"aw\""
++ #define DTORS_SECTION_ASM_OP	".section\t.dtors,\"aw\""
++ 
++ /* On svr4, we *do* have support for the .init and .fini sections, and we
++    can put stuff in there to be executed before and after `main'.  We let
++    crtstuff.c and other files know this by defining the following symbols.
++    The definitions say how to change sections to the .init and .fini
++    sections.  This is the same for all known svr4 assemblers.  */
++ 
++ #define INIT_SECTION_ASM_OP	".section\t.init"
++ #define FINI_SECTION_ASM_OP	".section\t.fini"
++ 
++ /* Support non-common, uninitialized data in the .bss section.  */
++ 
++ #define BSS_SECTION_ASM_OP	".section\t.bss"
++ 
++ /* A default list of other sections which we might be "in" at any given
++    time.  For targets that use additional sections (e.g. .tdesc) you
++    should override this definition in the target-specific file which
++    includes this file.  */
++ 
++ #undef EXTRA_SECTIONS
++ #define EXTRA_SECTIONS in_const, in_ctors, in_dtors, in_bss
++ 
++ /* A default list of extra section function definitions.  For targets
++    that use additional sections (e.g. .tdesc) you should override this
++    definition in the target-specific file which includes this file.  */
++ 
++ #undef EXTRA_SECTION_FUNCTIONS
++ #define EXTRA_SECTION_FUNCTIONS						\
++   CONST_SECTION_FUNCTION						\
++   CTORS_SECTION_FUNCTION						\
++   DTORS_SECTION_FUNCTION						\
++   BSS_SECTION_FUNCTION
++ 
++ #undef READONLY_DATA_SECTION
++ #define READONLY_DATA_SECTION() const_section ()
++ 
++ extern void text_section ();
++ 
++ #define CONST_SECTION_FUNCTION						\
++ void									\
++ const_section ()							\
++ {									\
++   if (!USE_CONST_SECTION)						\
++     text_section();							\
++   else if (in_section != in_const)					\
++     {									\
++       fprintf (asm_out_file, "%s\n", CONST_SECTION_ASM_OP);		\
++       in_section = in_const;						\
++     }									\
++ }
++ 
++ #define CTORS_SECTION_FUNCTION						\
++ void									\
++ ctors_section ()							\
++ {									\
++   if (in_section != in_ctors)						\
++     {									\
++       fprintf (asm_out_file, "%s\n", CTORS_SECTION_ASM_OP);		\
++       in_section = in_ctors;						\
++     }									\
++ }
++ 
++ #define DTORS_SECTION_FUNCTION						\
++ void									\
++ dtors_section ()							\
++ {									\
++   if (in_section != in_dtors)						\
++     {									\
++       fprintf (asm_out_file, "%s\n", DTORS_SECTION_ASM_OP);		\
++       in_section = in_dtors;						\
++     }									\
++ }
++ 
++ #define BSS_SECTION_FUNCTION						\
++ void									\
++ bss_section ()								\
++ {									\
++   if (in_section != in_bss)						\
++     {									\
++       fprintf (asm_out_file, "%s\n", BSS_SECTION_ASM_OP);		\
++       in_section = in_bss;						\
++     }									\
++ }
++ 
++ 
++ /* Switch into a generic section.
++    This is currently only used to support section attributes.
++ 
++    We make the section read-only and executable for a function decl,
++    read-only for a const data decl, and writable for a non-const data decl.  */
++ #define ASM_OUTPUT_SECTION_NAME(FILE, DECL, NAME) \
++   fprintf (FILE, ".section\t%s,\"%s\",@progbits\n", NAME, \
++ 	   (DECL) && TREE_CODE (DECL) == FUNCTION_DECL ? "ax" : \
++ 	   (DECL) && TREE_READONLY (DECL) ? "a" : "aw")
++ 
++ 
++ /* A C statement (sans semicolon) to output an element in the table of
++    global constructors.  */
++ #define ASM_OUTPUT_CONSTRUCTOR(FILE,NAME)				\
++   do {									\
++     ctors_section ();							\
++     fprintf (FILE, "\t%s\t ", INT_ASM_OP);				\
++     assemble_name (FILE, NAME);						\
++     fprintf (FILE, "\n");						\
++   } while (0)
++ 
++ /* A C statement (sans semicolon) to output an element in the table of
++    global destructors.  */
++ #define ASM_OUTPUT_DESTRUCTOR(FILE,NAME)       				\
++   do {									\
++     dtors_section ();                   				\
++     fprintf (FILE, "\t%s\t ", INT_ASM_OP);				\
++     assemble_name (FILE, NAME);              				\
++     fprintf (FILE, "\n");						\
++   } while (0)
++ 
++ /* A C statement or statements to switch to the appropriate
++    section for output of DECL.  DECL is either a `VAR_DECL' node
++    or a constant of some sort.  RELOC indicates whether forming
++    the initial value of DECL requires link-time relocations.  */
++ 
++ #define SELECT_SECTION(DECL,RELOC)					\
++ {									\
++   if (TREE_CODE (DECL) == STRING_CST)					\
++     {									\
++       if (! flag_writable_strings)					\
++ 	const_section ();						\
++       else								\
++ 	data_section ();						\
++     }									\
++   else if (TREE_CODE (DECL) == VAR_DECL)				\
++     {									\
++       if ((flag_pic && RELOC)						\
++ 	  || !TREE_READONLY (DECL) || TREE_SIDE_EFFECTS (DECL)		\
++ 	  || !DECL_INITIAL (DECL)					\
++ 	  || (DECL_INITIAL (DECL) != error_mark_node			\
++ 	      && !TREE_CONSTANT (DECL_INITIAL (DECL))))			\
++         {								\
++           if (DECL_COMMON (DECL)					\
++ 	      && !DECL_INITIAL (DECL))					\
++ 	          /* || DECL_INITIAL (DECL) == error_mark_node)) */	\
++ 	    bss_section();						\
++ 	  else								\
++ 	    data_section ();						\
++ 	}								\
++       else								\
++ 	const_section ();						\
++     }									\
++   else									\
++     const_section ();							\
++ }
++ 
++ /* A C statement or statements to switch to the appropriate
++    section for output of RTX in mode MODE.  RTX is some kind
++    of constant in RTL.  The argument MODE is redundant except
++    in the case of a `const_int' rtx.  Currently, these always
++    go into the const section.  */
++ 
++ #undef SELECT_RTX_SECTION
++ #define SELECT_RTX_SECTION(MODE,RTX) const_section()
++ 
++ /* Define the strings used for the special svr4 .type and .size directives.
++    These strings generally do not vary from one system running svr4 to
++    another, but if a given system (e.g. m88k running svr) needs to use
++    different pseudo-op names for these, they may be overridden in the
++    file which includes this one.  */
++ 
++ #define TYPE_ASM_OP	".type"
++ #define SIZE_ASM_OP	".size"
++ 
++ /* This is how we tell the assembler that a symbol is weak.  */
++ 
++ #define ASM_WEAKEN_LABEL(FILE,NAME) \
++   do { fputs ("\t.weak\t", FILE); assemble_name (FILE, NAME); \
++        fputc ('\n', FILE); } while (0)
++ 
++ /* This is how we tell the assembler that two symbols have the same value.  */
++ 
++ #define ASM_OUTPUT_DEF(FILE,NAME1,NAME2) \
++   do { assemble_name(FILE, NAME1); 	 \
++        fputs(" = ", FILE);		 \
++        assemble_name(FILE, NAME2);	 \
++        fputc('\n', FILE); } while (0)
++ 
++ /* The following macro defines the format used to output the second
++    operand of the .type assembler directive.  Different svr4 assemblers
++    expect various different forms for this operand.  The one given here
++    is just a default.  You may need to override it in your machine-
++    specific tm.h file (depending upon the particulars of your assembler).  */
++ 
++ #define TYPE_OPERAND_FMT	"@%s"
++ 
++ /* Write the extra assembler code needed to declare a function's result.
++    Most svr4 assemblers don't require any special declaration of the
++    result value, but there are exceptions.  */
++ 
++ #ifndef ASM_DECLARE_RESULT
++ #define ASM_DECLARE_RESULT(FILE, RESULT)
++ #endif
++ 
++ /* These macros generate the special .type and .size directives which
++    are used to set the corresponding fields of the linker symbol table
++    entries in an ELF object file under SVR4.  These macros also output
++    the starting labels for the relevant functions/objects.  */
++ 
++ /* Write the extra assembler code needed to declare an object properly.  */
++ 
++ #define ASM_DECLARE_OBJECT_NAME(FILE, NAME, DECL)			\
++   do {									\
++     fprintf (FILE, "\t%s\t ", TYPE_ASM_OP);				\
++     assemble_name (FILE, NAME);						\
++     putc (',', FILE);							\
++     fprintf (FILE, TYPE_OPERAND_FMT, "object");				\
++     putc ('\n', FILE);							\
++     size_directive_output = 0;						\
++     if (!flag_inhibit_size_directive && DECL_SIZE (DECL))		\
++       {									\
++ 	size_directive_output = 1;					\
++ 	fprintf (FILE, "\t%s\t ", SIZE_ASM_OP);				\
++ 	assemble_name (FILE, NAME);					\
++ 	fprintf (FILE, ",%d\n",  int_size_in_bytes (TREE_TYPE (DECL)));	\
++       }									\
++     ASM_OUTPUT_LABEL(FILE, NAME);					\
++   } while (0)
++ 
++ /* Output the size directive for a decl in rest_of_decl_compilation
++    in the case where we did not do so before the initializer.
++    Once we find the error_mark_node, we know that the value of
++    size_directive_output was set
++    by ASM_DECLARE_OBJECT_NAME when it was run for the same decl.  */
++ 
++ #define ASM_FINISH_DECLARE_OBJECT(FILE, DECL, TOP_LEVEL, AT_END)	 \
++ do {									 \
++      char *name = XSTR (XEXP (DECL_RTL (DECL), 0), 0);			 \
++      if (!flag_inhibit_size_directive && DECL_SIZE (DECL)		 \
++          && ! AT_END && TOP_LEVEL					 \
++ 	 && DECL_INITIAL (DECL) == error_mark_node			 \
++ 	 && !size_directive_output)					 \
++        {								 \
++ 	 size_directive_output = 1;					 \
++ 	 fprintf (FILE, "\t%s\t ", SIZE_ASM_OP);			 \
++ 	 assemble_name (FILE, name);					 \
++ 	 fprintf (FILE, ",%d\n",  int_size_in_bytes (TREE_TYPE (DECL))); \
++        }								 \
++    } while (0)
++ 
++ /* A table of bytes codes used by the ASM_OUTPUT_ASCII and
++    ASM_OUTPUT_LIMITED_STRING macros.  Each byte in the table
++    corresponds to a particular byte value [0..255].  For any
++    given byte value, if the value in the corresponding table
++    position is zero, the given character can be output directly.
++    If the table value is 1, the byte must be output as a \ooo
++    octal escape.  If the tables value is anything else, then the
++    byte value should be output as a \ followed by the value
++    in the table.  Note that we can use standard UN*X escape
++    sequences for many control characters, but we don't use
++    \a to represent BEL because some svr4 assemblers (e.g. on
++    the i386) don't know about that.  Also, we don't use \v
++    since some versions of gas, such as 2.2 did not accept it.  */
++ 
++ #define ESCAPES \
++ "\1\1\1\1\1\1\1\1btn\1fr\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\
++ \0\0\"\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\
++ \0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\\\0\0\0\
++ \0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\1\
++ \1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\
++ \1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\
++ \1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\
++ \1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1"
++ 
++ /* Some svr4 assemblers have a limit on the number of characters which
++    can appear in the operand of a .string directive.  If your assembler
++    has such a limitation, you should define STRING_LIMIT to reflect that
++    limit.  Note that at least some svr4 assemblers have a limit on the
++    actual number of bytes in the double-quoted string, and that they
++    count each character in an escape sequence as one byte.  Thus, an
++    escape sequence like \377 would count as four bytes.
++ 
++    If your target assembler doesn't support the .string directive, you
++    should define this to zero.
++ */
++ 
++ #define STRING_LIMIT	((unsigned) 256)
++ 
++ #define STRING_ASM_OP	".string"
++ 
++ /*
++  * We always use gas here, so we don't worry about ECOFF assembler problems.
++  */
++ #undef TARGET_GAS
++ #define TARGET_GAS	(1)
++ 
++ #undef PREFERRED_DEBUGGING_TYPE
++ #define PREFERRED_DEBUGGING_TYPE DBX_DEBUG
++ 
++ /* Provide a STARTFILE_SPEC appropriate for Linux.  Here we add
++    the Linux magical crtbegin.o file (see crtstuff.c) which
++    provides part of the support for getting C++ file-scope static
++    object constructed before entering `main'. */
++    
++ #undef	STARTFILE_SPEC
++ #define STARTFILE_SPEC \
++   "%{!shared: \
++      %{pg:gcrt1.o%s} %{!pg:%{p:gcrt1.o%s} %{!p:crt1.o%s}}}\
++    crti.o%s crtbegin.o%s"
++ 
++ /* Provide a ENDFILE_SPEC appropriate for Linux.  Here we tack on
++    the Linux magical crtend.o file (see crtstuff.c) which
++    provides part of the support for getting C++ file-scope static
++    object constructed before entering `main', followed by a normal
++    Linux "finalizer" file, `crtn.o'.  */
++ 
++ #undef	ENDFILE_SPEC
++ #define ENDFILE_SPEC \
++   "crtend.o%s crtn.o%s"
+diff -rcp2N gcc-2.7.2.2/config/alpha/linux.h g77-new/config/alpha/linux.h
+*** gcc-2.7.2.2/config/alpha/linux.h	Wed Dec 31 19:00:00 1969
+--- g77-new/config/alpha/linux.h	Thu Jul 10 20:08:49 1997
+***************
+*** 0 ****
+--- 1,72 ----
++ /* Definitions of target machine for GNU compiler, for Alpha Linux,
++    using ECOFF.
++    Copyright (C) 1995 Free Software Foundation, Inc.
++    Contributed by Bob Manson.
++    Derived from work contributed by Cygnus Support,
++    (c) 1993 Free Software Foundation.
++ 
++ This file is part of GNU CC.
++ 
++ GNU CC 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 CC 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 CC; see the file COPYING.  If not, write to
++ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
++ 
++ #define TARGET_DEFAULT (3 | MASK_GAS)
++ 
++ #include "alpha/alpha.h"
++ 
++ #undef TARGET_VERSION
++ #define TARGET_VERSION fprintf (stderr, " (Linux/Alpha)");
++ 
++ #undef CPP_PREDEFINES
++ #define CPP_PREDEFINES "\
++ -D__alpha -D__alpha__ -D__linux__ -D__linux -D_LONGLONG -Dlinux -Dunix \
++ -Asystem(linux) -Acpu(alpha) -Amachine(alpha)"
++ 
++ /* We don't actually need any of these; the MD_ vars are ignored
++    anyway for cross-compilers, and the other specs won't get picked up
++    'coz the user is supposed to do ld -r (hmm, perhaps that should be
++    the default).  In any case, setting them thus will catch some
++    common user errors. */
++ 
++ #undef	MD_EXEC_PREFIX
++ #undef	MD_STARTFILE_PREFIX
++ 
++ #undef	LIB_SPEC
++ #define LIB_SPEC "%{pg:-lgmon} %{pg:-lc_p} %{!pg:-lc}"
++ 
++ #undef	LINK_SPEC
++ #define LINK_SPEC  \
++   "-G 8 %{O*:-O3} %{!O*:-O1}"
++ 
++ #undef ASM_SPEC
++ #define ASM_SPEC "-nocpp"
++ 
++ /* Can't do stabs */
++ #undef SDB_DEBUGGING_INFO
++ 
++ /* Prefer dbx.  */
++ #undef PREFERRED_DEBUGGING_TYPE
++ #define PREFERRED_DEBUGGING_TYPE DBX_DEBUG
++ 
++ #undef FUNCTION_PROFILER
++ 
++ #define FUNCTION_PROFILER(FILE, LABELNO)			\
++     do {							\
++ 	fputs ("\tlda $27,_mcount\n", (FILE));			\
++ 	fputs ("\tjsr $26,($27),_mcount\n", (FILE));		\
++ 	fputs ("\tldgp $29,0($26)\n", (FILE));			\
++     } while (0);
++ 
++ /* Generate calls to memcpy, etc., not bcopy, etc. */
++ #define TARGET_MEM_FUNCTIONS
+diff -rcp2N gcc-2.7.2.2/config/alpha/t-linux g77-new/config/alpha/t-linux
+*** gcc-2.7.2.2/config/alpha/t-linux	Wed Dec 31 19:00:00 1969
+--- g77-new/config/alpha/t-linux	Thu Jul 10 20:08:49 1997
+***************
+*** 0 ****
+--- 1,3 ----
++ # Our header files are supposed to be correct, nein?
++ FIXINCLUDES = 
++ STMP_FIXPROTO =
+diff -rcp2N gcc-2.7.2.2/config/alpha/x-linux g77-new/config/alpha/x-linux
+*** gcc-2.7.2.2/config/alpha/x-linux	Wed Dec 31 19:00:00 1969
+--- g77-new/config/alpha/x-linux	Thu Jul 10 20:08:49 1997
+***************
+*** 0 ****
+--- 1 ----
++ CLIB=-lbfd -liberty
+diff -rcp2N gcc-2.7.2.2/config/alpha/xm-alpha.h g77-new/config/alpha/xm-alpha.h
+*** gcc-2.7.2.2/config/alpha/xm-alpha.h	Thu Aug 31 17:52:27 1995
+--- g77-new/config/alpha/xm-alpha.h	Thu Jul 10 20:08:49 1997
+*************** Boston, MA 02111-1307, USA.  */
+*** 46,51 ****
+--- 46,53 ----
+  #include <alloca.h>
+  #else
++ #ifndef alloca
+  extern void *alloca ();
+  #endif
++ #endif
+  
+  /* The host compiler has problems with enum bitfields since it makes
+*************** extern void *malloc (), *realloc (), *ca
+*** 68,72 ****
+--- 70,76 ----
+  /* OSF/1 has vprintf.  */
+  
++ #ifndef linux  /* 1996/02/22 mauro@craftwork.com -- unreliable with Linux */
+  #define HAVE_VPRINTF
++ #endif
+  
+  /* OSF/1 has putenv.  */
+diff -rcp2N gcc-2.7.2.2/config/alpha/xm-linux.h g77-new/config/alpha/xm-linux.h
+*** gcc-2.7.2.2/config/alpha/xm-linux.h	Wed Dec 31 19:00:00 1969
+--- g77-new/config/alpha/xm-linux.h	Thu Jul 10 20:08:49 1997
+***************
+*** 0 ****
+--- 1,10 ----
++ #ifndef _XM_LINUX_H
++ #define _XM_LINUX_H
++ 
++ #include "xm-alpha.h"
++ 
++ #define HAVE_STRERROR
++ 
++ #define DONT_DECLARE_SYS_SIGLIST
++ #define USE_BFD
++ #endif
+diff -rcp2N gcc-2.7.2.2/config/i386/i386.c g77-new/config/i386/i386.c
+*** gcc-2.7.2.2/config/i386/i386.c	Sun Oct 22 07:13:21 1995
+--- g77-new/config/i386/i386.c	Sun Aug 10 18:46:09 1997
+*************** standard_80387_constant_p (x)
+*** 1290,1294 ****
+    set_float_handler (handler);
+    REAL_VALUE_FROM_CONST_DOUBLE (d, x);
+!   is0 = REAL_VALUES_EQUAL (d, dconst0);
+    is1 = REAL_VALUES_EQUAL (d, dconst1);
+    set_float_handler (NULL_PTR);
+--- 1290,1294 ----
+    set_float_handler (handler);
+    REAL_VALUE_FROM_CONST_DOUBLE (d, x);
+!   is0 = REAL_VALUES_EQUAL (d, dconst0) && !REAL_VALUE_MINUS_ZERO (d);
+    is1 = REAL_VALUES_EQUAL (d, dconst1);
+    set_float_handler (NULL_PTR);
+diff -rcp2N gcc-2.7.2.2/config/mips/mips.c g77-new/config/mips/mips.c
+*** gcc-2.7.2.2/config/mips/mips.c	Thu Feb 20 19:24:13 1997
+--- g77-new/config/mips/mips.c	Sun Aug 10 18:45:43 1997
+*************** expand_block_move (operands)
+*** 2360,2365 ****
+  
+    else if (constp && bytes <= 2*MAX_MOVE_BYTES)
+!     emit_insn (gen_movstrsi_internal (gen_rtx (MEM, BLKmode, dest_reg),
+! 				      gen_rtx (MEM, BLKmode, src_reg),
+  				      bytes_rtx, align_rtx));
+  
+--- 2360,2367 ----
+  
+    else if (constp && bytes <= 2*MAX_MOVE_BYTES)
+!     emit_insn (gen_movstrsi_internal (change_address (operands[0],
+! 						      BLKmode, dest_reg),
+! 				      change_address (orig_src, BLKmode,
+! 						      src_reg),
+  				      bytes_rtx, align_rtx));
+  
+diff -rcp2N gcc-2.7.2.2/config/mips/mips.h g77-new/config/mips/mips.h
+*** gcc-2.7.2.2/config/mips/mips.h	Thu Nov  9 11:23:09 1995
+--- g77-new/config/mips/mips.h	Sun Aug 10 18:46:44 1997
+*************** typedef struct mips_args {
+*** 2160,2170 ****
+      }									    \
+  									    \
+!   /* Flush the instruction cache.  */					    \
+!   /* ??? Are the modes right? Maybe they should depend on -mint64/-mlong64? */\
+    /* ??? Should check the return value for errors.  */			    \
+!   emit_library_call (gen_rtx (SYMBOL_REF, Pmode, "cacheflush"),		    \
+  		     0, VOIDmode, 3, addr, Pmode,			    \
+  		     GEN_INT (TRAMPOLINE_SIZE), SImode,  		    \
+! 		     GEN_INT (1), SImode);				    \
+  }
+  
+--- 2160,2170 ----
+      }									    \
+  									    \
+!   /* Flush both caches.  We need to flush the data cache in case	    \
+!      the system has a write-back cache.  */				    \
+    /* ??? Should check the return value for errors.  */			    \
+!   emit_library_call (gen_rtx (SYMBOL_REF, Pmode, "_flush_cache"),	    \
+  		     0, VOIDmode, 3, addr, Pmode,			    \
+  		     GEN_INT (TRAMPOLINE_SIZE), SImode,  		    \
+! 		     GEN_INT (3), TYPE_MODE (integer_type_node));	    \
+  }
+  
+*************** typedef struct mips_args {
+*** 2388,2392 ****
+    ((GET_CODE (X) != CONST_DOUBLE					\
+      || mips_const_double_ok (X, GET_MODE (X)))				\
+!    && ! (GET_CODE (X) == CONST && ABI_64BIT))
+  
+  /* A C compound statement that attempts to replace X with a valid
+--- 2388,2393 ----
+    ((GET_CODE (X) != CONST_DOUBLE					\
+      || mips_const_double_ok (X, GET_MODE (X)))				\
+!    && ! (GET_CODE (X) == CONST						\
+! 	 && (ABI_64BIT || GET_CODE (XEXP (X, 0)) == MINUS)))
+  
+  /* A C compound statement that attempts to replace X with a valid
+diff -rcp2N gcc-2.7.2.2/config/mips/sni-gas.h g77-new/config/mips/sni-gas.h
+*** gcc-2.7.2.2/config/mips/sni-gas.h	Wed Dec 31 19:00:00 1969
+--- g77-new/config/mips/sni-gas.h	Sun Aug 10 18:46:33 1997
+***************
+*** 0 ****
+--- 1,43 ----
++ #include "mips/sni-svr4.h"
++ 
++ /* Enable debugging.  */
++ #define DBX_DEBUGGING_INFO
++ #define SDB_DEBUGGING_INFO
++ #define MIPS_DEBUGGING_INFO
++ 
++ #define DWARF_DEBUGGING_INFO
++ #undef PREFERRED_DEBUGGING_TYPE
++ #define PREFERRED_DEBUGGING_TYPE DWARF_DEBUG
++ 
++ /* We need to use .esize and .etype instead of .size and .type to
++    avoid conflicting with ELF directives.  These are only recognized
++    by gas, anyhow, not the native assembler.  */
++ #undef PUT_SDB_SIZE
++ #define PUT_SDB_SIZE(a)                                       \
++ do {                                                  \
++   extern FILE *asm_out_text_file;                     \
++   fprintf (asm_out_text_file, "\t.esize\t%d;", (a));  \
++ } while (0)
++ 
++ #undef PUT_SDB_TYPE
++ #define PUT_SDB_TYPE(a)                                       \
++ do {                                                  \
++   extern FILE *asm_out_text_file;                     \
++   fprintf (asm_out_text_file, "\t.etype\t0x%x;", (a));        \
++ } while (0)
++ 
++ 
++ /* This is how to equate one symbol to another symbol.  The syntax used is
++    `SYM1=SYM2'.  Note that this is different from the way equates are done
++    with most svr4 assemblers, where the syntax is `.set SYM1,SYM2'.  */
++ 
++ #define ASM_OUTPUT_DEF(FILE,LABEL1,LABEL2)				\
++  do {	fprintf ((FILE), "\t");						\
++ 	assemble_name (FILE, LABEL1);					\
++ 	fprintf (FILE, " = ");						\
++ 	assemble_name (FILE, LABEL2);					\
++ 	fprintf (FILE, "\n");						\
++   } while (0)
++ 
++ 
++ 
+diff -rcp2N gcc-2.7.2.2/config/mips/sni-svr4.h g77-new/config/mips/sni-svr4.h
+*** gcc-2.7.2.2/config/mips/sni-svr4.h	Wed Dec 31 19:00:00 1969
+--- g77-new/config/mips/sni-svr4.h	Sun Aug 10 18:46:33 1997
+***************
+*** 0 ****
+--- 1,103 ----
++ /* Definitions of target machine for GNU compiler.  SNI SINIX version.
++    Copyright (C) 1996 Free Software Foundation, Inc.
++    Contributed by Marco Walther (Marco.Walther@mch.sni.de).
++ 
++ This file is part of GNU CC.
++ 
++ GNU CC 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 CC 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 CC; see the file COPYING.  If not, write to
++ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
++ 
++ #define MIPS_SVR4
++ 
++ #define CPP_PREDEFINES "\
++ -Dmips -Dunix -Dhost_mips -DMIPSEB -DR3000 -DSYSTYPE_SVR4 \
++ -D_mips -D_unix -D_host_mips -D_MIPSEB -D_R3000 -D_SYSTYPE_SVR4 \
++ -Asystem(unix) -Asystem(svr4) -Acpu(mips) -Amachine(mips)"
++ 
++ #define CPP_SPEC "\
++ %{.cc:	-D__LANGUAGE_C_PLUS_PLUS -D_LANGUAGE_C_PLUS_PLUS} \
++ %{.cxx:	-D__LANGUAGE_C_PLUS_PLUS -D_LANGUAGE_C_PLUS_PLUS} \
++ %{.C:	-D__LANGUAGE_C_PLUS_PLUS -D_LANGUAGE_C_PLUS_PLUS} \
++ %{.m:	-D__LANGUAGE_OBJECTIVE_C -D_LANGUAGE_OBJECTIVE_C} \
++ %{.S:	-D__LANGUAGE_ASSEMBLY -D_LANGUAGE_ASSEMBLY %{!ansi:-DLANGUAGE_ASSEMBLY}} \
++ %{.s:	-D__LANGUAGE_ASSEMBLY -D_LANGUAGE_ASSEMBLY %{!ansi:-DLANGUAGE_ASSEMBLY}} \
++ %{!.S:%{!.s:	-D__LANGUAGE_C -D_LANGUAGE_C %{!ansi:-DLANGUAGE_C}}} \
++ -D__SIZE_TYPE__=unsigned\\ int -D__PTRDIFF_TYPE__=int"
++ 
++ #define LINK_SPEC "\
++ %{G*} \
++ %{!mgas: \
++ 	%{dy} %{dn}}"
++ 		    
++ #define LIB_SPEC "\
++ 	%{p:-lprof1} \
++ 	%{!p:%{pg:-lprof1} \
++ 	     %{!pg:-L/usr/ccs/lib/ -lc /usr/ccs/lib/crtn.o%s}}"
++ 
++ #define STARTFILE_SPEC "\
++ 	%{pg:gcrt0.o%s} \
++ 	%{!pg:%{p:mcrt0.o%s} \
++ 	       %{!p:/usr/ccs/lib/crt1.o /usr/ccs/lib/crti.o /usr/ccs/lib/values-Xt.o%s}}"
++ 
++ /* Mips System V.4 doesn't have a getpagesize() function needed by the
++    trampoline code, so use the POSIX sysconf function to get it.
++    This is only done when compiling the trampoline code.  */
++ 
++ #ifdef  L_trampoline
++ #include <unistd.h>
++ 
++ #define getpagesize()	sysconf(_SC_PAGE_SIZE)
++ #endif /*  L_trampoline */
++ 
++ /* Use atexit for static constructors/destructors, instead of defining
++    our own exit function.  */
++ #define HAVE_ATEXIT
++ 
++ /* Generate calls to memcpy, etc., not bcopy, etc.  */
++ #define TARGET_MEM_FUNCTIONS
++ 
++ #define OBJECT_FORMAT_ELF
++ 
++ #define	TARGET_DEFAULT	MASK_ABICALLS
++ #define ABICALLS_ASM_OP ".option pic2"
++ 
++ #define MACHINE_TYPE "SNI running SINIX 5.42"
++ 
++ #define MIPS_DEFAULT_GVALUE	0
++ 
++ #define NM_FLAGS	"-p"
++ 
++ /* wir haben ein Problem, wenn in einem Assembler-File keine .text-section
++    erzeugt wird. Dann landen diese Pseudo-Labels in irgendeiner anderen
++    section, z.B. .reginfo. Das macht den ld sehr ungluecklich. */
++ 
++ #define ASM_IDENTIFY_GCC(mw_stream) \
++ 	fprintf(mw_stream, "\t.ident \"gcc2_compiled.\"\n");
++ 
++ #define ASM_IDENTIFY_LANGUAGE(STREAM)
++ 
++ #define ASM_LONG	".word\t"
++ #define ASM_GLOBAL	".rdata\n\t\t.globl\t"
++ 
++ #include "mips/mips.h"
++ 
++ /* We do not want to run mips-tfile!  */
++ #undef ASM_FINAL_SPEC
++ 
++ #undef OBJECT_FORMAT_COFF
++ 
++ /* We don't support debugging info for now. */
++ #undef DBX_DEBUGGING_INFO
++ #undef SDB_DEBUGGING_INFO
++ #undef MIPS_DEBUGGING_INFO
+diff -rcp2N gcc-2.7.2.2/config/mips/x-sni-svr4 g77-new/config/mips/x-sni-svr4
+*** gcc-2.7.2.2/config/mips/x-sni-svr4	Wed Dec 31 19:00:00 1969
+--- g77-new/config/mips/x-sni-svr4	Sun Aug 10 18:46:33 1997
+***************
+*** 0 ****
+--- 1,18 ----
++ # Define CC and OLDCC as the same, so that the tests:
++ #	if [ x"$(OLDCC)" = x"$(CC)" ] ...
++ #
++ # will succeed (if OLDCC != CC, it is assumed that GCC is
++ # being used in secondary stage builds).
++ # -Olimit is so the user can use -O2.  Down with fixed
++ # size tables!
++ 
++ CC		= $(OLDCC)
++ OPT		=
++ OLDCC		= cc -Olimit 3000 $(OPT)
++ 
++ X_CFLAGS	= -DNO_SYS_SIGLIST
++ 
++ # Show we need to use the C version of ALLOCA
++ # The SVR3 configurations have it, but the SVR4 configurations don't.
++ # For now, just try using it for all SVR* configurations.
++ ALLOCA		= alloca.o
+diff -rcp2N gcc-2.7.2.2/config/msdos/configur.bat g77-new/config/msdos/configur.bat
+*** gcc-2.7.2.2/config/msdos/configur.bat	Mon Aug 28 05:55:47 1995
+--- g77-new/config/msdos/configur.bat	Sun Aug 10 19:08:05 1997
+*************** sed -f config/msdos/top.sed Makefile.in 
+*** 18,21 ****
+--- 18,27 ----
+  set LANG=

+  

++ if not exist ada\make-lang.in goto no_ada

++ sed -f config/msdos/top.sed ada\make-lang.in >> Makefile

++ sed -f config/msdos/top.sed ada\makefile.in > ada\Makefile

++ set LANG=%LANG% ada.&	

++ :no_ada

++ 

+  if not exist cp\make-lang.in goto no_cp

+  sed -f config/msdos/top.sed cp\make-lang.in >> Makefile

+diff -rcp2N gcc-2.7.2.2/config/pa/pa.c g77-new/config/pa/pa.c
+*** gcc-2.7.2.2/config/pa/pa.c	Sun Oct 22 07:45:20 1995
+--- g77-new/config/pa/pa.c	Sun Aug 10 18:45:44 1997
+*************** output_move_double (operands)
+*** 1344,1369 ****
+       do them in the other order.
+  
+!      RMS says "This happens only for registers;
+!      such overlap can't happen in memory unless the user explicitly
+!      sets it up, and that is an undefined circumstance."
+! 
+!      but it happens on the HP-PA when loading parameter registers,
+!      so I am going to define that circumstance, and make it work
+!      as expected.  */
+  
+!   if (optype0 == REGOP && (optype1 == MEMOP || optype1 == OFFSOP)
+! 	   && reg_overlap_mentioned_p (operands[0], XEXP (operands[1], 0)))
+      {
+-       /* XXX THIS PROBABLY DOESN'T WORK.  */
+        /* Do the late half first.  */
+        if (addreg1)
+  	output_asm_insn ("ldo 4(%0),%0", &addreg1);
+        output_asm_insn (singlemove_string (latehalf), latehalf);
+        if (addreg1)
+  	output_asm_insn ("ldo -4(%0),%0", &addreg1);
+-       /* Then clobber.  */
+        return singlemove_string (operands);
+      }
+  
+    if (optype0 == REGOP && optype1 == REGOP
+        && REGNO (operands[0]) == REGNO (operands[1]) + 1)
+--- 1344,1377 ----
+       do them in the other order.
+  
+!      This can happen in two cases:
+  
+! 	mem -> register where the first half of the destination register
+!  	is the same register used in the memory's address.  Reload
+! 	can create such insns.
+! 
+! 	mem in this case will be either register indirect or register
+! 	indirect plus a valid offset. 
+! 
+! 	register -> register move where REGNO(dst) == REGNO(src + 1)
+! 	someone (Tim/Tege?) claimed this can happen for parameter loads. 
+! 
+!      Handle mem -> register case first.  */
+!   if (optype0 == REGOP
+!       && (optype1 == MEMOP || optype1 == OFFSOP)
+!       && refers_to_regno_p (REGNO (operands[0]), REGNO (operands[0]) + 1,
+! 			    operands[1], 0))
+      {
+        /* Do the late half first.  */
+        if (addreg1)
+  	output_asm_insn ("ldo 4(%0),%0", &addreg1);
+        output_asm_insn (singlemove_string (latehalf), latehalf);
++ 
++       /* Then clobber.  */
+        if (addreg1)
+  	output_asm_insn ("ldo -4(%0),%0", &addreg1);
+        return singlemove_string (operands);
+      }
+  
++   /* Now handle register -> register case.  */
+    if (optype0 == REGOP && optype1 == REGOP
+        && REGNO (operands[0]) == REGNO (operands[1]) + 1)
+diff -rcp2N gcc-2.7.2.2/config/pa/pa.md g77-new/config/pa/pa.md
+*** gcc-2.7.2.2/config/pa/pa.md	Mon Aug 14 09:00:49 1995
+--- g77-new/config/pa/pa.md	Sun Aug 10 18:45:45 1997
+***************
+*** 1828,1832 ****
+  (define_insn ""
+    [(set (match_operand:DF 0 "reg_or_nonsymb_mem_operand"
+! 			  "=f,*r,Q,?o,?Q,f,*&r,*&r")
+  	(match_operand:DF 1 "reg_or_0_or_nonsymb_mem_operand"
+  			  "fG,*rG,f,*r,*r,Q,o,Q"))]
+--- 1828,1832 ----
+  (define_insn ""
+    [(set (match_operand:DF 0 "reg_or_nonsymb_mem_operand"
+! 			  "=f,*r,Q,?o,?Q,f,*r,*r")
+  	(match_operand:DF 1 "reg_or_0_or_nonsymb_mem_operand"
+  			  "fG,*rG,f,*r,*r,Q,o,Q"))]
+***************
+*** 1846,1850 ****
+  (define_insn ""
+    [(set (match_operand:DF 0 "reg_or_nonsymb_mem_operand"
+! 			  "=r,?o,?Q,&r,&r")
+  	(match_operand:DF 1 "reg_or_0_or_nonsymb_mem_operand"
+  			  "rG,r,r,o,Q"))]
+--- 1846,1850 ----
+  (define_insn ""
+    [(set (match_operand:DF 0 "reg_or_nonsymb_mem_operand"
+! 			  "=r,?o,?Q,r,r")
+  	(match_operand:DF 1 "reg_or_0_or_nonsymb_mem_operand"
+  			  "rG,r,r,o,Q"))]
+***************
+*** 2019,2023 ****
+  (define_insn ""
+    [(set (match_operand:DI 0 "reg_or_nonsymb_mem_operand"
+! 			  "=r,o,Q,&r,&r,&r,f,f,*T")
+  	(match_operand:DI 1 "general_operand"
+  			  "rM,r,r,o,Q,i,fM,*T,f"))]
+--- 2019,2023 ----
+  (define_insn ""
+    [(set (match_operand:DI 0 "reg_or_nonsymb_mem_operand"
+! 			  "=r,o,Q,r,r,r,f,f,*T")
+  	(match_operand:DI 1 "general_operand"
+  			  "rM,r,r,o,Q,i,fM,*T,f"))]
+***************
+*** 2037,2041 ****
+  (define_insn ""
+    [(set (match_operand:DI 0 "reg_or_nonsymb_mem_operand"
+! 			  "=r,o,Q,&r,&r,&r")
+  	(match_operand:DI 1 "general_operand"
+  			  "rM,r,r,o,Q,i"))]
+--- 2037,2041 ----
+  (define_insn ""
+    [(set (match_operand:DI 0 "reg_or_nonsymb_mem_operand"
+! 			  "=r,o,Q,r,r,r")
+  	(match_operand:DI 1 "general_operand"
+  			  "rM,r,r,o,Q,i"))]
+diff -rcp2N gcc-2.7.2.2/config/rs6000/rs6000.c g77-new/config/rs6000/rs6000.c
+*** gcc-2.7.2.2/config/rs6000/rs6000.c	Thu Feb 20 19:24:14 1997
+--- g77-new/config/rs6000/rs6000.c	Sun Aug 10 04:44:05 1997
+*************** input_operand (op, mode)
+*** 724,730 ****
+      return 1;
+  
+!   /* For HImode and QImode, any constant is valid. */
+!   if ((mode == HImode || mode == QImode)
+!       && GET_CODE (op) == CONST_INT)
+      return 1;
+  
+--- 724,729 ----
+      return 1;
+  
+!   /* For integer modes, any constant is ok.  */
+!   if (GET_CODE (op) == CONST_INT)
+      return 1;
+  
+diff -rcp2N gcc-2.7.2.2/config/sparc/sol2.h g77-new/config/sparc/sol2.h
+*** gcc-2.7.2.2/config/sparc/sol2.h	Sat Aug 19 17:36:45 1995
+--- g77-new/config/sparc/sol2.h	Sun Aug 10 18:45:53 1997
+*************** do {									\
+*** 166,168 ****
+  /* Define for support of TFmode long double and REAL_ARITHMETIC.
+     Sparc ABI says that long double is 4 words.  */
+! #define LONG_DOUBLE_TYPE_SIZE 128
+--- 166,168 ----
+  /* Define for support of TFmode long double and REAL_ARITHMETIC.
+     Sparc ABI says that long double is 4 words.  */
+! #define LONG_DOUBLE_TYPE_SIZE 64
+diff -rcp2N gcc-2.7.2.2/config/sparc/sparc.c g77-new/config/sparc/sparc.c
+*** gcc-2.7.2.2/config/sparc/sparc.c	Tue Sep 12 18:32:24 1995
+--- g77-new/config/sparc/sparc.c	Sun Aug 10 18:46:03 1997
+*************** Boston, MA 02111-1307, USA.  */
+*** 40,46 ****
+  /* 1 if the caller has placed an "unimp" insn immediately after the call.
+     This is used in v8 code when calling a function that returns a structure.
+!    v9 doesn't have this.  */
+  
+! #define SKIP_CALLERS_UNIMP_P (!TARGET_V9 && current_function_returns_struct)
+  
+  /* Global variables for machine-dependent things.  */
+--- 40,51 ----
+  /* 1 if the caller has placed an "unimp" insn immediately after the call.
+     This is used in v8 code when calling a function that returns a structure.
+!    v9 doesn't have this.  Be careful to have this test be the same as that
+!    used on the call.  */
+  
+! #define SKIP_CALLERS_UNIMP_P  \
+! (!TARGET_V9 && current_function_returns_struct			\
+!  && ! integer_zerop (DECL_SIZE (DECL_RESULT (current_function_decl)))	\
+!  && (TREE_CODE (DECL_SIZE (DECL_RESULT (current_function_decl)))	\
+!      == INTEGER_CST))
+  
+  /* Global variables for machine-dependent things.  */
+diff -rcp2N gcc-2.7.2.2/config/sparc/sparc.h g77-new/config/sparc/sparc.h
+*** gcc-2.7.2.2/config/sparc/sparc.h	Thu Feb 20 19:24:15 1997
+--- g77-new/config/sparc/sparc.h	Sun Aug 10 18:46:13 1997
+*************** extern int leaf_function;
+*** 1526,1533 ****
+  
+  /* Output assembler code to FILE to increment profiler label # LABELNO
+!    for profiling a function entry.  */
+  
+  #define FUNCTION_PROFILER(FILE, LABELNO)  			\
+    do {								\
+      fputs ("\tsethi %hi(", (FILE));				\
+      ASM_OUTPUT_INTERNAL_LABELREF (FILE, "LP", LABELNO);		\
+--- 1526,1540 ----
+  
+  /* Output assembler code to FILE to increment profiler label # LABELNO
+!    for profiling a function entry.
+! 
+!    32 bit sparc uses %g2 as the STATIC_CHAIN_REGNUM which gets clobbered
+!    during profiling so we need to save/restore it around the call to mcount.
+!    We're guaranteed that a save has just been done, and we use the space
+!    allocated for intreg/fpreg value passing.  */
+  
+  #define FUNCTION_PROFILER(FILE, LABELNO)  			\
+    do {								\
++     if (! TARGET_V9)					\
++       fputs ("\tst %g2,[%fp-4]\n", FILE);			\
+      fputs ("\tsethi %hi(", (FILE));				\
+      ASM_OUTPUT_INTERNAL_LABELREF (FILE, "LP", LABELNO);		\
+*************** extern int leaf_function;
+*** 1539,1542 ****
+--- 1546,1551 ----
+      ASM_OUTPUT_INTERNAL_LABELREF (FILE, "LP", LABELNO);		\
+      fputs ("),%o0,%o0\n", (FILE));				\
++     if (! TARGET_V9)					\
++       fputs ("\tld [%fp-4],%g2\n", FILE);			\
+    } while (0)
+  
+diff -rcp2N gcc-2.7.2.2/config/sparc/sparc.md g77-new/config/sparc/sparc.md
+*** gcc-2.7.2.2/config/sparc/sparc.md	Tue Sep 12 18:57:35 1995
+--- g77-new/config/sparc/sparc.md	Sun Aug 10 18:46:27 1997
+***************
+*** 4799,4803 ****
+      abort ();
+  
+!  if (GET_CODE (XEXP (operands[0], 0)) == LABEL_REF)
+      {
+        /* This is really a PIC sequence.  We want to represent
+--- 4799,4803 ----
+      abort ();
+  
+!   if (GET_CODE (XEXP (operands[0], 0)) == LABEL_REF)
+      {
+        /* This is really a PIC sequence.  We want to represent
+***************
+*** 4809,4824 ****
+  
+        if (! TARGET_V9 && INTVAL (operands[3]) != 0)
+! 	emit_jump_insn (gen_rtx (PARALLEL, VOIDmode, gen_rtvec (3,
+! 				 gen_rtx (SET, VOIDmode, pc_rtx,
+! 					  XEXP (operands[0], 0)),
+! 				 operands[3],
+! 				 gen_rtx (CLOBBER, VOIDmode,
+! 					  gen_rtx (REG, Pmode, 15)))));
+        else
+! 	emit_jump_insn (gen_rtx (PARALLEL, VOIDmode, gen_rtvec (2,
+! 				 gen_rtx (SET, VOIDmode, pc_rtx,
+! 					  XEXP (operands[0], 0)),
+! 				 gen_rtx (CLOBBER, VOIDmode,
+! 					  gen_rtx (REG, Pmode, 15)))));
+        goto finish_call;
+      }
+--- 4809,4828 ----
+  
+        if (! TARGET_V9 && INTVAL (operands[3]) != 0)
+! 	emit_jump_insn
+! 	  (gen_rtx (PARALLEL, VOIDmode,
+! 		    gen_rtvec (3,
+! 			       gen_rtx (SET, VOIDmode, pc_rtx,
+! 					XEXP (operands[0], 0)),
+! 			       GEN_INT (INTVAL (operands[3]) & 0xfff),
+! 			       gen_rtx (CLOBBER, VOIDmode,
+! 					gen_rtx (REG, Pmode, 15)))));
+        else
+! 	emit_jump_insn
+! 	  (gen_rtx (PARALLEL, VOIDmode,
+! 		    gen_rtvec (2,
+! 			       gen_rtx (SET, VOIDmode, pc_rtx,
+! 					XEXP (operands[0], 0)),
+! 			       gen_rtx (CLOBBER, VOIDmode,
+! 					gen_rtx (REG, Pmode, 15)))));
+        goto finish_call;
+      }
+***************
+*** 4839,4852 ****
+  
+    if (! TARGET_V9 && INTVAL (operands[3]) != 0)
+!     emit_call_insn (gen_rtx (PARALLEL, VOIDmode, gen_rtvec (3,
+! 			     gen_rtx (CALL, VOIDmode, fn_rtx, nregs_rtx),
+! 			     operands[3],
+! 			     gen_rtx (CLOBBER, VOIDmode,
+! 					       gen_rtx (REG, Pmode, 15)))));
+    else
+!     emit_call_insn (gen_rtx (PARALLEL, VOIDmode, gen_rtvec (2,
+! 			     gen_rtx (CALL, VOIDmode, fn_rtx, nregs_rtx),
+! 			     gen_rtx (CLOBBER, VOIDmode,
+! 					       gen_rtx (REG, Pmode, 15)))));
+  
+   finish_call:
+--- 4843,4858 ----
+  
+    if (! TARGET_V9 && INTVAL (operands[3]) != 0)
+!     emit_call_insn
+!       (gen_rtx (PARALLEL, VOIDmode,
+! 		gen_rtvec (3, gen_rtx (CALL, VOIDmode, fn_rtx, nregs_rtx),
+! 			   GEN_INT (INTVAL (operands[3]) & 0xfff),
+! 			   gen_rtx (CLOBBER, VOIDmode,
+! 				    gen_rtx (REG, Pmode, 15)))));
+    else
+!     emit_call_insn
+!       (gen_rtx (PARALLEL, VOIDmode,
+! 		gen_rtvec (2, gen_rtx (CALL, VOIDmode, fn_rtx, nregs_rtx),
+! 			   gen_rtx (CLOBBER, VOIDmode,
+! 				    gen_rtx (REG, Pmode, 15)))));
+  
+   finish_call:
+***************
+*** 4911,4915 ****
+     (clobber (reg:SI 15))]
+    ;;- Do not use operand 1 for most machines.
+!   "! TARGET_V9 && GET_CODE (operands[2]) == CONST_INT && INTVAL (operands[2]) > 0"
+    "call %a0,%1\;nop\;unimp %2"
+    [(set_attr "type" "call_no_delay_slot")])
+--- 4917,4921 ----
+     (clobber (reg:SI 15))]
+    ;;- Do not use operand 1 for most machines.
+!   "! TARGET_V9 && GET_CODE (operands[2]) == CONST_INT && INTVAL (operands[2]) >= 0"
+    "call %a0,%1\;nop\;unimp %2"
+    [(set_attr "type" "call_no_delay_slot")])
+***************
+*** 4923,4927 ****
+     (clobber (reg:SI 15))]
+    ;;- Do not use operand 1 for most machines.
+!   "! TARGET_V9 && GET_CODE (operands[2]) == CONST_INT && INTVAL (operands[2]) > 0"
+    "call %a0,%1\;nop\;unimp %2"
+    [(set_attr "type" "call_no_delay_slot")])
+--- 4929,4933 ----
+     (clobber (reg:SI 15))]
+    ;;- Do not use operand 1 for most machines.
+!   "! TARGET_V9 && GET_CODE (operands[2]) == CONST_INT && INTVAL (operands[2]) >= 0"
+    "call %a0,%1\;nop\;unimp %2"
+    [(set_attr "type" "call_no_delay_slot")])
+***************
+*** 5178,5184 ****
+    emit_insn (gen_rtx (USE, VOIDmode, stack_pointer_rtx));
+    emit_insn (gen_rtx (USE, VOIDmode, static_chain_rtx));
+-   emit_insn (gen_rtx (USE, VOIDmode, gen_rtx (REG, Pmode, 8)));
+    /* Return, restoring reg window and jumping to goto handler.  */
+    emit_insn (gen_goto_handler_and_restore ());
+    DONE;
+  }")
+--- 5184,5190 ----
+    emit_insn (gen_rtx (USE, VOIDmode, stack_pointer_rtx));
+    emit_insn (gen_rtx (USE, VOIDmode, static_chain_rtx));
+    /* Return, restoring reg window and jumping to goto handler.  */
+    emit_insn (gen_goto_handler_and_restore ());
++   emit_barrier ();
+    DONE;
+  }")
+***************
+*** 5192,5200 ****
+  
+  (define_insn "goto_handler_and_restore"
+!   [(unspec_volatile [(const_int 0)] 2)]
+    ""
+    "jmp %%o0+0\;restore"
+    [(set_attr "type" "misc")
+     (set_attr "length" "2")])
+  
+  ;; Special pattern for the FLUSH instruction.
+--- 5198,5237 ----
+  
+  (define_insn "goto_handler_and_restore"
+!   [(unspec_volatile [(const_int 0)] 2)
+!    (use (reg:SI 8))]
+    ""
+    "jmp %%o0+0\;restore"
+    [(set_attr "type" "misc")
+     (set_attr "length" "2")])
++ 
++ ;; Pattern for use after a setjmp to store FP and the return register
++ ;; into the stack area.
++ 
++ (define_expand "setjmp"
++   [(const_int 0)]
++   ""
++   "
++ {
++   if (TARGET_V9)
++     emit_insn (gen_setjmp_64 ());
++   else
++     emit_insn (gen_setjmp_32 ());
++ 
++   DONE;
++ }")
++ 
++ (define_expand "setjmp_32"
++   [(set (mem:SI (plus:SI (reg:SI 14) (const_int 56))) (match_dup 0))
++    (set (mem:SI (plus:SI (reg:SI 14) (const_int 60))) (reg:SI 31))]
++   ""
++   "
++ { operands[0] = frame_pointer_rtx; }")
++ 
++ (define_expand "setjmp_64"
++   [(set (mem:DI (plus:DI (reg:DI 14) (const_int 112))) (match_dup 0))
++    (set (mem:DI (plus:DI (reg:DI 14) (const_int 120))) (reg:DI 31))]
++   ""
++   "
++ { operands[0] = frame_pointer_rtx; }")
+  
+  ;; Special pattern for the FLUSH instruction.
+diff -rcp2N gcc-2.7.2.2/config/x-linux g77-new/config/x-linux
+*** gcc-2.7.2.2/config/x-linux	Tue Mar 28 07:43:37 1995
+--- g77-new/config/x-linux	Thu Jul 10 20:08:49 1997
+*************** BOOT_CFLAGS = -O $(CFLAGS) -Iinclude
+*** 13,14 ****
+--- 13,17 ----
+  # Don't run fixproto
+  STMP_FIXPROTO =
++ 
++ # Don't install "assert.h" in gcc. We use the one in glibc.
++ INSTALL_ASSERT_H =
+diff -rcp2N gcc-2.7.2.2/config/x-linux-aout g77-new/config/x-linux-aout
+*** gcc-2.7.2.2/config/x-linux-aout	Wed Dec 31 19:00:00 1969
+--- g77-new/config/x-linux-aout	Thu Jul 10 20:08:49 1997
+***************
+*** 0 ****
+--- 1,14 ----
++ # It is defined in config/xm-linux.h.
++ # X_CFLAGS = -DPOSIX
++ 
++ # The following is needed when compiling stages 2 and 3 because gcc's
++ # limits.h must be picked up before /usr/include/limits.h.  This is because
++ # each does an #include_next of the other if the other hasn't been included.
++ # /usr/include/limits.h loses if it gets found first because /usr/include is
++ # at the end of the search order.  When a new version of gcc is released,
++ # gcc's limits.h hasn't been installed yet and hence isn't found.
++ 
++ BOOT_CFLAGS = -O $(CFLAGS) -Iinclude
++ 
++ # Don't run fixproto
++ STMP_FIXPROTO =
+diff -rcp2N gcc-2.7.2.2/config.guess g77-new/config.guess
+*** gcc-2.7.2.2/config.guess	Thu Feb 20 19:24:32 1997
+--- g77-new/config.guess	Thu Jul 10 20:08:50 1997
+*************** trap 'rm -f dummy.c dummy.o dummy; exit 
+*** 52,63 ****
+  
+  case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
+-     alpha:OSF1:V*:*)
+- 	# After 1.2, OSF1 uses "V1.3" for uname -r.
+- 	echo alpha-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^V//'`
+- 	exit 0 ;;
+      alpha:OSF1:*:*)
+  	# 1.2 uses "1.2" for uname -r.
+! 	echo alpha-dec-osf${UNAME_RELEASE}
+!         exit 0 ;;
+      21064:Windows_NT:50:3)
+  	echo alpha-dec-winnt3.5
+--- 52,62 ----
+  
+  case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
+      alpha:OSF1:*:*)
++ 	# A Vn.n version is a released version.
++ 	# A Tn.n version is a released field test version.
++ 	# A Xn.n version is an unreleased experimental baselevel.
+  	# 1.2 uses "1.2" for uname -r.
+! 	echo alpha-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[VTX]//'`
+! 	exit 0 ;;
+      21064:Windows_NT:50:3)
+  	echo alpha-dec-winnt3.5
+*************** case "${UNAME_MACHINE}:${UNAME_SYSTEM}:$
+*** 154,161 ****
+  	echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'`
+  	exit 0 ;;
+!    ????????:AIX?:[12].1:2)   # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX.
+  	echo romp-ibm-aix      # uname -m gives an 8 hex-code CPU id
+  	exit 0 ;;              # Note that: echo "'`uname -s`'" gives 'AIX '
+!     i[34]86:AIX:*:*)
+  	echo i386-ibm-aix
+  	exit 0 ;;
+--- 153,160 ----
+  	echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'`
+  	exit 0 ;;
+!     ????????:AIX?:[12].1:2)   # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX.
+  	echo romp-ibm-aix      # uname -m gives an 8 hex-code CPU id
+  	exit 0 ;;              # Note that: echo "'`uname -s`'" gives 'AIX '
+!     i?86:AIX:*:*)
+  	echo i386-ibm-aix
+  	exit 0 ;;
+*************** EOF
+*** 220,224 ****
+  	    9000/31? )            HP_ARCH=m68000 ;;
+  	    9000/[34]?? )         HP_ARCH=m68k ;;
+! 	    9000/7?? | 9000/8?[79] ) HP_ARCH=hppa1.1 ;;
+  	    9000/8?? )            HP_ARCH=hppa1.0 ;;
+  	esac
+--- 219,223 ----
+  	    9000/31? )            HP_ARCH=m68000 ;;
+  	    9000/[34]?? )         HP_ARCH=m68k ;;
+! 	    9000/7?? | 9000/8?[1679] ) HP_ARCH=hppa1.1 ;;
+  	    9000/8?? )            HP_ARCH=hppa1.0 ;;
+  	esac
+*************** EOF
+*** 304,308 ****
+  	echo m68k-hp-netbsd${UNAME_RELEASE}
+  	exit 0 ;;
+!     i[34]86:BSD/386:*:* | *:BSD/OS:*:*)
+  	echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE}
+  	exit 0 ;;
+--- 303,307 ----
+  	echo m68k-hp-netbsd${UNAME_RELEASE}
+  	exit 0 ;;
+!     i?86:BSD/386:*:* | *:BSD/OS:*:*)
+  	echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE}
+  	exit 0 ;;
+*************** EOF
+*** 314,318 ****
+  	exit 0 ;;
+      *:GNU:*:*)
+! 	echo `echo ${UNAME_MACHINE}|sed -e 's,/.*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'`
+  	exit 0 ;;
+      *:Linux:*:*)
+--- 313,317 ----
+  	exit 0 ;;
+      *:GNU:*:*)
+! 	echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'`
+  	exit 0 ;;
+      *:Linux:*:*)
+*************** EOF
+*** 320,330 ****
+  	# first see if it will tell us.
+  	ld_help_string=`ld --help 2>&1`
+! #	if echo $ld_help_string | grep >/dev/null 2>&1 "supported emulations: elf_i[345]86"; then
+  #	  echo "${UNAME_MACHINE}-unknown-linux" ; exit 0
+! 	if echo $ld_help_string | grep >/dev/null 2>&1 "supported emulations: i[345]86linux"; then
+  	  echo "${UNAME_MACHINE}-unknown-linuxaout" ; exit 0
+! 	elif echo $ld_help_string | grep >/dev/null 2>&1 "supported emulations: i[345]86coff"; then
+  	  echo "${UNAME_MACHINE}-unknown-linuxcoff" ; exit 0
+  	elif test "${UNAME_MACHINE}" = "alpha" ; then
+  	  echo alpha-unknown-linux ; exit 0
+  	else
+--- 319,333 ----
+  	# first see if it will tell us.
+  	ld_help_string=`ld --help 2>&1`
+! #	if echo $ld_help_string | grep >/dev/null 2>&1 "supported emulations: elf_i?86"; then
+  #	  echo "${UNAME_MACHINE}-unknown-linux" ; exit 0
+! 	if echo $ld_help_string | grep >/dev/null 2>&1 "supported emulations: i?86linux"; then
+  	  echo "${UNAME_MACHINE}-unknown-linuxaout" ; exit 0
+! 	elif echo $ld_help_string | grep >/dev/null 2>&1 "supported emulations: i?86coff"; then
+  	  echo "${UNAME_MACHINE}-unknown-linuxcoff" ; exit 0
+  	elif test "${UNAME_MACHINE}" = "alpha" ; then
++ 	  as_version_string=`as --version 2>&1`
++ 	  if echo $as_version_string | grep >/dev/null 2>&1 " version 2.6 "; then
++ 	    echo alpha-unknown-linuxoldas ; exit 0
++ 	  fi
+  	  echo alpha-unknown-linux ; exit 0
+  	else
+*************** EOF
+*** 363,370 ****
+  # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there.  earlier versions
+  # are messed up and put the nodename in both sysname and nodename.
+!     i[34]86:DYNIX/ptx:4*:*)
+  	echo i386-sequent-sysv4
+  	exit 0 ;;
+!     i[34]86:*:4.*:* | i[34]86:SYSTEM_V:4.*:*)
+  	if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then
+  		echo ${UNAME_MACHINE}-univel-sysv${UNAME_RELEASE}
+--- 366,373 ----
+  # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there.  earlier versions
+  # are messed up and put the nodename in both sysname and nodename.
+!     i?86:DYNIX/ptx:4*:*)
+  	echo i386-sequent-sysv4
+  	exit 0 ;;
+!     i?86:*:4.*:* | i?86:SYSTEM_V:4.*:*)
+  	if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then
+  		echo ${UNAME_MACHINE}-univel-sysv${UNAME_RELEASE}
+*************** EOF
+*** 373,377 ****
+  	fi
+  	exit 0 ;;
+!     i[34]86:*:3.2:*)
+  	if test -f /usr/options/cb.name; then
+  		UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name`
+--- 376,380 ----
+  	fi
+  	exit 0 ;;
+!     i?86:*:3.2:*)
+  	if test -f /usr/options/cb.name; then
+  		UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name`
+*************** EOF
+*** 380,383 ****
+--- 383,388 ----
+  		UNAME_REL=`(/bin/uname -X|egrep Release|sed -e 's/.*= //')`
+  		(/bin/uname -X|egrep i80486 >/dev/null) && UNAME_MACHINE=i486
++ 		(/bin/uname -X|egrep '^Machine.*Pentium' >/dev/null) \
++ 			&& UNAME_MACHINE=i586
+  		echo ${UNAME_MACHINE}-unknown-sco$UNAME_REL
+  	else
+*************** EOF
+*** 402,406 ****
+  	echo m68010-convergent-sysv
+  	exit 0 ;;
+!     M680[234]0:*:R3V[567]*:*)
+  	test -r /sysV68 && echo 'm68k-motorola-sysv' && exit 0 ;;
+      3[34]??:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0)
+--- 407,411 ----
+  	echo m68010-convergent-sysv
+  	exit 0 ;;
+!     M68*:*:R3V[567]*:*)
+  	test -r /sysV68 && echo 'm68k-motorola-sysv' && exit 0 ;;
+      3[34]??:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0)
+*************** EOF
+*** 410,414 ****
+          uname -p 2>/dev/null | grep 86 >/dev/null \
+            && echo i486-ncr-sysv4 && exit 0 ;;
+!     m680[234]0:LynxOS:2.[23]*:*)
+  	echo m68k-lynx-lynxos${UNAME_RELEASE}
+  	exit 0 ;;
+--- 415,419 ----
+          uname -p 2>/dev/null | grep 86 >/dev/null \
+            && echo i486-ncr-sysv4 && exit 0 ;;
+!     m68*:LynxOS:2.*:*)
+  	echo m68k-lynx-lynxos${UNAME_RELEASE}
+  	exit 0 ;;
+*************** EOF
+*** 416,426 ****
+  	echo m68k-atari-sysv4
+  	exit 0 ;;
+!     i[34]86:LynxOS:2.[23]*:*)
+  	echo i386-lynx-lynxos${UNAME_RELEASE}
+  	exit 0 ;;
+!     TSUNAMI:LynxOS:2.[23]*:*)
+  	echo sparc-lynx-lynxos${UNAME_RELEASE}
+  	exit 0 ;;
+!     rs6000:LynxOS:2.[23]*:*)
+  	echo rs6000-lynx-lynxos${UNAME_RELEASE}
+  	exit 0 ;;
+--- 421,431 ----
+  	echo m68k-atari-sysv4
+  	exit 0 ;;
+!     i?86:LynxOS:2.*:*)
+  	echo i386-lynx-lynxos${UNAME_RELEASE}
+  	exit 0 ;;
+!     TSUNAMI:LynxOS:2.*:*)
+  	echo sparc-lynx-lynxos${UNAME_RELEASE}
+  	exit 0 ;;
+!     rs6000:LynxOS:2.*:* | PowerPC:LynxOS:2.*:*)
+  	echo rs6000-lynx-lynxos${UNAME_RELEASE}
+  	exit 0 ;;
+*************** main ()
+*** 479,483 ****
+    int version;
+    version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`;
+!   printf ("%s-next-nextstep%s\n", __ARCHITECTURE__,  version==2 ? "2" : "3");
+    exit (0);
+  #endif
+--- 484,488 ----
+    int version;
+    version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`;
+!   printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version);
+    exit (0);
+  #endif
+diff -rcp2N gcc-2.7.2.2/config.sub g77-new/config.sub
+*** gcc-2.7.2.2/config.sub	Thu Jun 15 17:01:49 1995
+--- g77-new/config.sub	Thu Jul 10 20:08:50 1997
+*************** case $basic_machine in
+*** 130,134 ****
+  	# Recognize the basic CPU types without company name.
+  	# Some are omitted here because they have special meanings below.
+! 	tahoe | i[345]86 | i860 | m68k | m68000 | m88k | ns32k | arm \
+  		| arme[lb] | pyramid \
+  		| tron | a29k | 580 | i960 | h8300 | hppa1.0 | hppa1.1 \
+--- 130,134 ----
+  	# Recognize the basic CPU types without company name.
+  	# Some are omitted here because they have special meanings below.
+! 	tahoe | i[3456]86 | i860 | m68k | m68000 | m88k | ns32k | arm \
+  		| arme[lb] | pyramid \
+  		| tron | a29k | 580 | i960 | h8300 | hppa1.0 | hppa1.1 \
+*************** case $basic_machine in
+*** 145,149 ****
+  		;;
+  	# Recognize the basic CPU types with company name.
+! 	vax-* | tahoe-* | i[345]86-* | i860-* | m68k-* | m68000-* | m88k-* \
+  	      | sparc-* | ns32k-* | fx80-* | arm-* | c[123]* \
+  	      | mips-* | pyramid-* | tron-* | a29k-* | romp-* | rs6000-* | power-* \
+--- 145,149 ----
+  		;;
+  	# Recognize the basic CPU types with company name.
+! 	vax-* | tahoe-* | i[3456]86-* | i860-* | m68k-* | m68000-* | m88k-* \
+  	      | sparc-* | ns32k-* | fx80-* | arm-* | c[123]* \
+  	      | mips-* | pyramid-* | tron-* | a29k-* | romp-* | rs6000-* | power-* \
+*************** case $basic_machine in
+*** 309,325 ****
+  		;;
+  # I'm not sure what "Sysv32" means.  Should this be sysv3.2?
+! 	i[345]86v32)
+  		basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'`
+  		os=-sysv32
+  		;;
+! 	i[345]86v4*)
+  		basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'`
+  		os=-sysv4
+  		;;
+! 	i[345]86v)
+  		basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'`
+  		os=-sysv
+  		;;
+! 	i[345]86sol2)
+  		basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'`
+  		os=-solaris2
+--- 309,325 ----
+  		;;
+  # I'm not sure what "Sysv32" means.  Should this be sysv3.2?
+! 	i[3456]86v32)
+  		basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'`
+  		os=-sysv32
+  		;;
+! 	i[3456]86v4*)
+  		basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'`
+  		os=-sysv4
+  		;;
+! 	i[3456]86v)
+  		basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'`
+  		os=-sysv
+  		;;
+! 	i[3456]86sol2)
+  		basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'`
+  		os=-solaris2
+diff -rcp2N gcc-2.7.2.2/configure g77-new/configure
+*** gcc-2.7.2.2/configure	Thu Feb 20 19:24:33 1997
+--- g77-new/configure	Sun Aug 10 18:46:31 1997
+*************** exec_prefix='$(prefix)'
+*** 82,85 ****
+--- 82,86 ----
+  # The default g++ include directory is $(libdir)/g++-include.
+  gxx_include_dir='$(libdir)/g++-include'
++ #gxx_include_dir='$(exec_prefix)/include/g++'
+  
+  # Default --program-transform-name to nothing.
+*************** for machine in $canon_build $canon_host 
+*** 548,551 ****
+--- 549,578 ----
+  		use_collect2=yes
+  		;;
++ 	alpha-*-linux*oldas*)
++ 		tm_file=alpha/linux.h
++ 		tmake_file=alpha/t-linux
++ 		xmake_file=alpha/x-linux
++ 		fixincludes=Makefile.in
++ 		xm_file=alpha/xm-linux.h
++ 		gas=yes gnu_ld=yes
++ 		;;
++ 	alpha-*-linux*ecoff*)
++ 		tm_file=alpha/linux.h
++ 		tmake_file=alpha/t-linux
++ 		xmake_file=alpha/x-linux
++ 		fixincludes=Makefile.in
++ 		xm_file=alpha/xm-linux.h
++ 		extra_parts="crtbegin.o crtbeginS.o crtend.o crtendS.o"
++ 		gas=yes gnu_ld=yes
++ 		;;
++ 	alpha-*-linux*)
++                 tm_file=alpha/elf.h
++                 tmake_file=alpha/t-linux
++                 xmake_file=alpha/x-linux
++                 fixincludes=Makefile.in
++                 xm_file=alpha/xm-linux.h
++                 extra_parts="crtbegin.o crtbeginS.o crtend.o crtendS.o"
++                 gas=yes gnu_ld=yes
++                 ;;
+  	alpha-dec-osf[23456789]*)
+  		tm_file=alpha/osf2.h
+*************** for machine in $canon_build $canon_host 
+*** 985,989 ****
+  		cpu_type=i386		# with a.out format using pre BFD linkers
+  		xm_file=i386/xm-linux.h
+! 		xmake_file=x-linux
+  		tm_file=i386/linux-oldld.h
+  		fixincludes=Makefile.in # The headers are ok already.
+--- 1012,1016 ----
+  		cpu_type=i386		# with a.out format using pre BFD linkers
+  		xm_file=i386/xm-linux.h
+! 		xmake_file=x-linux-aout
+  		tm_file=i386/linux-oldld.h
+  		fixincludes=Makefile.in # The headers are ok already.
+*************** for machine in $canon_build $canon_host 
+*** 994,998 ****
+  		cpu_type=i386		# with a.out format
+  		xm_file=i386/xm-linux.h
+! 		xmake_file=x-linux
+  		tm_file=i386/linux-aout.h
+  		fixincludes=Makefile.in # The headers are ok already.
+--- 1021,1025 ----
+  		cpu_type=i386		# with a.out format
+  		xm_file=i386/xm-linux.h
+! 		xmake_file=x-linux-aout
+  		tm_file=i386/linux-aout.h
+  		fixincludes=Makefile.in # The headers are ok already.
+*************** for machine in $canon_build $canon_host 
+*** 1003,1007 ****
+  		cpu_type=i386		# with ELF format, using GNU libc v1.
+  		xm_file=i386/xm-linux.h
+! 		xmake_file=x-linux
+  		tmake_file=t-linux-libc1
+  		tm_file=i386/linux.h
+--- 1030,1034 ----
+  		cpu_type=i386		# with ELF format, using GNU libc v1.
+  		xm_file=i386/xm-linux.h
+! 		xmake_file=x-linux-aout
+  		tmake_file=t-linux-libc1
+  		tm_file=i386/linux.h
+*************** for machine in $canon_build $canon_host 
+*** 1651,1654 ****
+--- 1678,1702 ----
+  		use_collect2=yes
+  		;;
++         mips-sni-sysv4)
++ 		if [ x$gas = xyes ]
++ 		then
++ 			if [ x$stabs = xyes ]
++ 			then
++ 				tm_file=mips/iris5gdb.h
++ 			else
++ 				tm_file=mips/sni-gas.h
++ 			fi
++ 		else
++ 			tm_file=mips/sni-svr4.h
++ 		fi
++                 xm_file=mips/xm-sysv.h
++                 xmake_file=mips/x-sni-svr4
++                 tmake_file=mips/t-mips-gas
++                 if [ x$gnu_ld != xyes ]
++                 then
++                         use_collect2=yes
++                 fi
++                 broken_install=yes
++                 ;;
+  	mips-sgi-irix5*)		# SGI System V.4., IRIX 5
+  		if [ x$gas = xyes ]
+*************** MAYBE_TARGET_DEFAULT = -DTARGET_CPU_DEFA
+*** 2980,2984 ****
+  	rm Makefile.sed
+  	echo 's|||' > Makefile.sed
+! 	echo "s|^target=.*$|target=${target}|" >> Makefile.sed
+  	echo "s|^xmake_file=.*$|xmake_file=${dep_host_xmake_file}|" >> Makefile.sed
+  	echo "s|^tmake_file=.*$|tmake_file=${dep_tmake_file}|" >> Makefile.sed
+--- 3028,3032 ----
+  	rm Makefile.sed
+  	echo 's|||' > Makefile.sed
+! 	echo "s|^target=.*$|target=${canon_target}|" >> Makefile.sed
+  	echo "s|^xmake_file=.*$|xmake_file=${dep_host_xmake_file}|" >> Makefile.sed
+  	echo "s|^tmake_file=.*$|tmake_file=${dep_tmake_file}|" >> Makefile.sed
+diff -rcp2N gcc-2.7.2.2/cse.c g77-new/cse.c
+*** gcc-2.7.2.2/cse.c	Sun Nov 26 14:47:05 1995
+--- g77-new/cse.c	Sun Aug 10 18:46:37 1997
+*************** static struct table_elt *last_jump_equiv
+*** 520,544 ****
+  static int constant_pool_entries_cost;
+  
+- /* Bits describing what kind of values in memory must be invalidated
+-    for a particular instruction.  If all three bits are zero,
+-    no memory refs need to be invalidated.  Each bit is more powerful
+-    than the preceding ones, and if a bit is set then the preceding
+-    bits are also set.
+- 
+-    Here is how the bits are set:
+-    Pushing onto the stack invalidates only the stack pointer,
+-    writing at a fixed address invalidates only variable addresses,
+-    writing in a structure element at variable address
+-      invalidates all but scalar variables,
+-    and writing in anything else at variable address invalidates everything.  */
+- 
+- struct write_data
+- {
+-   int sp : 1;			/* Invalidate stack pointer. */
+-   int var : 1;			/* Invalidate variable addresses.  */
+-   int nonscalar : 1;		/* Invalidate all but scalar variables.  */
+-   int all : 1;			/* Invalidate all memory refs.  */
+- };
+- 
+  /* Define maximum length of a branch path.  */
+  
+--- 520,523 ----
+*************** static void merge_equiv_classes PROTO((s
+*** 626,632 ****
+  				       struct table_elt *));
+  static void invalidate		PROTO((rtx, enum machine_mode));
+  static void remove_invalid_refs	PROTO((int));
+  static void rehash_using_reg	PROTO((rtx));
+! static void invalidate_memory	PROTO((struct write_data *));
+  static void invalidate_for_call	PROTO((void));
+  static rtx use_related_value	PROTO((rtx, struct table_elt *));
+--- 605,612 ----
+  				       struct table_elt *));
+  static void invalidate		PROTO((rtx, enum machine_mode));
++ static int cse_rtx_varies_p	PROTO((rtx));
+  static void remove_invalid_refs	PROTO((int));
+  static void rehash_using_reg	PROTO((rtx));
+! static void invalidate_memory	PROTO((void));
+  static void invalidate_for_call	PROTO((void));
+  static rtx use_related_value	PROTO((rtx, struct table_elt *));
+*************** static void set_nonvarying_address_compo
+*** 638,644 ****
+  						     HOST_WIDE_INT *));
+  static int refers_to_p		PROTO((rtx, rtx));
+- static int refers_to_mem_p	PROTO((rtx, rtx, HOST_WIDE_INT,
+- 				       HOST_WIDE_INT));
+- static int cse_rtx_addr_varies_p PROTO((rtx));
+  static rtx canon_reg		PROTO((rtx, rtx));
+  static void find_best_addr	PROTO((rtx, rtx *));
+--- 618,621 ----
+*************** static void record_jump_cond	PROTO((enum
+*** 656,661 ****
+  				       rtx, rtx, int));
+  static void cse_insn		PROTO((rtx, int));
+! static void note_mem_written	PROTO((rtx, struct write_data *));
+! static void invalidate_from_clobbers PROTO((struct write_data *, rtx));
+  static rtx cse_process_notes	PROTO((rtx, rtx));
+  static void cse_around_loop	PROTO((rtx));
+--- 633,638 ----
+  				       rtx, rtx, int));
+  static void cse_insn		PROTO((rtx, int));
+! static int note_mem_written	PROTO((rtx));
+! static void invalidate_from_clobbers PROTO((rtx));
+  static rtx cse_process_notes	PROTO((rtx, rtx));
+  static void cse_around_loop	PROTO((rtx));
+*************** invalidate (x, full_mode)
+*** 1512,1517 ****
+    register int i;
+    register struct table_elt *p;
+-   rtx base;
+-   HOST_WIDE_INT start, end;
+  
+    /* If X is a register, dependencies on its contents
+--- 1489,1492 ----
+*************** invalidate (x, full_mode)
+*** 1605,1611 ****
+      full_mode = GET_MODE (x);
+  
+-   set_nonvarying_address_components (XEXP (x, 0), GET_MODE_SIZE (full_mode),
+- 				     &base, &start, &end);
+- 
+    for (i = 0; i < NBUCKETS; i++)
+      {
+--- 1580,1583 ----
+*************** invalidate (x, full_mode)
+*** 1614,1618 ****
+  	{
+  	  next = p->next_same_hash;
+! 	  if (refers_to_mem_p (p->exp, base, start, end))
+  	    remove_from_table (p, i);
+  	}
+--- 1586,1594 ----
+  	{
+  	  next = p->next_same_hash;
+! 	  /* Invalidate ASM_OPERANDS which reference memory (this is easier
+! 	     than checking all the aliases).  */
+! 	  if (p->in_memory
+! 	      && (GET_CODE (p->exp) != MEM
+! 		  || true_dependence (x, full_mode, p->exp, cse_rtx_varies_p)))
+  	    remove_from_table (p, i);
+  	}
+*************** rehash_using_reg (x)
+*** 1695,1722 ****
+  }
+  
+- /* Remove from the hash table all expressions that reference memory,
+-    or some of them as specified by *WRITES.  */
+- 
+- static void
+- invalidate_memory (writes)
+-      struct write_data *writes;
+- {
+-   register int i;
+-   register struct table_elt *p, *next;
+-   int all = writes->all;
+-   int nonscalar = writes->nonscalar;
+- 
+-   for (i = 0; i < NBUCKETS; i++)
+-     for (p = table[i]; p; p = next)
+-       {
+- 	next = p->next_same_hash;
+- 	if (p->in_memory
+- 	    && (all
+- 		|| (nonscalar && p->in_struct)
+- 		|| cse_rtx_addr_varies_p (p->exp)))
+- 	  remove_from_table (p, i);
+-       }
+- }
+- 
+  /* Remove from the hash table any expression that is a call-clobbered
+     register.  Also update their TICK values.  */
+--- 1671,1674 ----
+*************** invalidate_for_call ()
+*** 1756,1759 ****
+--- 1708,1717 ----
+  	  next = p->next_same_hash;
+  
++ 	  if (p->in_memory)
++ 	    {
++ 	      remove_from_table (p, hash);
++ 	      continue;
++ 	    }
++ 
+  	  if (GET_CODE (p->exp) != REG
+  	      || REGNO (p->exp) >= FIRST_PSEUDO_REGISTER)
+*************** canon_hash (x, mode)
+*** 1946,1950 ****
+  	  return 0;
+  	}
+!       if (! RTX_UNCHANGING_P (x))
+  	{
+  	  hash_arg_in_memory = 1;
+--- 1904,1908 ----
+  	  return 0;
+  	}
+!       if (! RTX_UNCHANGING_P (x) || FIXED_BASE_PLUS_P (XEXP (x, 0)))
+  	{
+  	  hash_arg_in_memory = 1;
+*************** set_nonvarying_address_components (addr,
+*** 2395,2477 ****
+  }
+  
+! /* Return 1 iff any subexpression of X refers to memory
+!    at an address of BASE plus some offset
+!    such that any of the bytes' offsets fall between START (inclusive)
+!    and END (exclusive).
+! 
+!    The value is undefined if X is a varying address (as determined by
+!    cse_rtx_addr_varies_p).  This function is not used in such cases.
+! 
+!    When used in the cse pass, `qty_const' is nonzero, and it is used
+!    to treat an address that is a register with a known constant value
+!    as if it were that constant value.
+!    In the loop pass, `qty_const' is zero, so this is not done.  */
+! 
+! static int
+! refers_to_mem_p (x, base, start, end)
+!      rtx x, base;
+!      HOST_WIDE_INT start, end;
+! {
+!   register HOST_WIDE_INT i;
+!   register enum rtx_code code;
+!   register char *fmt;
+! 
+!  repeat:
+!   if (x == 0)
+!     return 0;
+! 
+!   code = GET_CODE (x);
+!   if (code == MEM)
+!     {
+!       register rtx addr = XEXP (x, 0);	/* Get the address.  */
+!       rtx mybase;
+!       HOST_WIDE_INT mystart, myend;
+! 
+!       set_nonvarying_address_components (addr, GET_MODE_SIZE (GET_MODE (x)),
+! 					 &mybase, &mystart, &myend);
+! 
+! 
+!       /* refers_to_mem_p is never called with varying addresses. 
+! 	 If the base addresses are not equal, there is no chance
+! 	 of the memory addresses conflicting.  */
+!       if (! rtx_equal_p (mybase, base))
+! 	return 0;
+! 
+!       return myend > start && mystart < end;
+!     }
+! 
+!   /* X does not match, so try its subexpressions.  */
+! 
+!   fmt = GET_RTX_FORMAT (code);
+!   for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--)
+!     if (fmt[i] == 'e')
+!       {
+! 	if (i == 0)
+! 	  {
+! 	    x = XEXP (x, 0);
+! 	    goto repeat;
+! 	  }
+! 	else
+! 	  if (refers_to_mem_p (XEXP (x, i), base, start, end))
+! 	    return 1;
+!       }
+!     else if (fmt[i] == 'E')
+!       {
+! 	int j;
+! 	for (j = 0; j < XVECLEN (x, i); j++)
+! 	  if (refers_to_mem_p (XVECEXP (x, i, j), base, start, end))
+! 	    return 1;
+!       }
+! 
+!   return 0;
+! }
+! 
+! /* Nonzero if X refers to memory at a varying address;
+     except that a register which has at the moment a known constant value
+     isn't considered variable.  */
+  
+  static int
+! cse_rtx_addr_varies_p (x)
+!      rtx x;
+  {
+    /* We need not check for X and the equivalence class being of the same
+--- 2353,2363 ----
+  }
+  
+! /* Nonzero if X, a memory address, refers to a varying address;
+     except that a register which has at the moment a known constant value
+     isn't considered variable.  */
+  
+  static int
+! cse_rtx_varies_p (x)
+!      register rtx x;
+  {
+    /* We need not check for X and the equivalence class being of the same
+*************** cse_rtx_addr_varies_p (x)
+*** 2479,2497 ****
+       doesn't vary in any mode.  */
+  
+!   if (GET_CODE (x) == MEM
+!       && GET_CODE (XEXP (x, 0)) == REG
+!       && REGNO_QTY_VALID_P (REGNO (XEXP (x, 0)))
+!       && GET_MODE (XEXP (x, 0)) == qty_mode[reg_qty[REGNO (XEXP (x, 0))]]
+!       && qty_const[reg_qty[REGNO (XEXP (x, 0))]] != 0)
+      return 0;
+  
+!   if (GET_CODE (x) == MEM
+!       && GET_CODE (XEXP (x, 0)) == PLUS
+!       && GET_CODE (XEXP (XEXP (x, 0), 1)) == CONST_INT
+!       && GET_CODE (XEXP (XEXP (x, 0), 0)) == REG
+!       && REGNO_QTY_VALID_P (REGNO (XEXP (XEXP (x, 0), 0)))
+!       && (GET_MODE (XEXP (XEXP (x, 0), 0))
+! 	  == qty_mode[reg_qty[REGNO (XEXP (XEXP (x, 0), 0))]])
+!       && qty_const[reg_qty[REGNO (XEXP (XEXP (x, 0), 0))]])
+      return 0;
+  
+--- 2365,2381 ----
+       doesn't vary in any mode.  */
+  
+!   if (GET_CODE (x) == REG
+!       && REGNO_QTY_VALID_P (REGNO (x))
+!       && GET_MODE (x) == qty_mode[reg_qty[REGNO (x)]]
+!       && qty_const[reg_qty[REGNO (x)]] != 0)
+      return 0;
+  
+!   if (GET_CODE (x) == PLUS
+!       && GET_CODE (XEXP (x, 1)) == CONST_INT
+!       && GET_CODE (XEXP (x, 0)) == REG
+!       && REGNO_QTY_VALID_P (REGNO (XEXP (x, 0)))
+!       && (GET_MODE (XEXP (x, 0))
+! 	  == qty_mode[reg_qty[REGNO (XEXP (x, 0))]])
+!       && qty_const[reg_qty[REGNO (XEXP (x, 0))]])
+      return 0;
+  
+*************** cse_rtx_addr_varies_p (x)
+*** 2501,2519 ****
+       load fp minus a constant into a register, then a MEM which is the
+       sum of the two `constant' registers.  */
+!   if (GET_CODE (x) == MEM
+!       && GET_CODE (XEXP (x, 0)) == PLUS
+!       && GET_CODE (XEXP (XEXP (x, 0), 0)) == REG
+!       && GET_CODE (XEXP (XEXP (x, 0), 1)) == REG
+!       && REGNO_QTY_VALID_P (REGNO (XEXP (XEXP (x, 0), 0)))
+!       && (GET_MODE (XEXP (XEXP (x, 0), 0))
+! 	  == qty_mode[reg_qty[REGNO (XEXP (XEXP (x, 0), 0))]])
+!       && qty_const[reg_qty[REGNO (XEXP (XEXP (x, 0), 0))]]
+!       && REGNO_QTY_VALID_P (REGNO (XEXP (XEXP (x, 0), 1)))
+!       && (GET_MODE (XEXP (XEXP (x, 0), 1))
+! 	  == qty_mode[reg_qty[REGNO (XEXP (XEXP (x, 0), 1))]])
+!       && qty_const[reg_qty[REGNO (XEXP (XEXP (x, 0), 1))]])
+      return 0;
+  
+!   return rtx_addr_varies_p (x);
+  }
+  
+--- 2385,2402 ----
+       load fp minus a constant into a register, then a MEM which is the
+       sum of the two `constant' registers.  */
+!   if (GET_CODE (x) == PLUS
+!       && GET_CODE (XEXP (x, 0)) == REG
+!       && GET_CODE (XEXP (x, 1)) == REG
+!       && REGNO_QTY_VALID_P (REGNO (XEXP (x, 0)))
+!       && (GET_MODE (XEXP (x, 0))
+! 	  == qty_mode[reg_qty[REGNO (XEXP (x, 0))]])
+!       && qty_const[reg_qty[REGNO (XEXP (x, 0))]]
+!       && REGNO_QTY_VALID_P (REGNO (XEXP (x, 1)))
+!       && (GET_MODE (XEXP (x, 1))
+! 	  == qty_mode[reg_qty[REGNO (XEXP (x, 1))]])
+!       && qty_const[reg_qty[REGNO (XEXP (x, 1))]])
+      return 0;
+  
+!   return rtx_varies_p (x);
+  }
+  
+*************** cse_insn (insn, in_libcall_block)
+*** 6105,6110 ****
+    rtx this_insn_cc0 = 0;
+    enum machine_mode this_insn_cc0_mode;
+-   struct write_data writes_memory;
+-   static struct write_data init = {0, 0, 0, 0};
+  
+    rtx src_eqv = 0;
+--- 5988,5991 ----
+*************** cse_insn (insn, in_libcall_block)
+*** 6118,6122 ****
+  
+    this_insn = insn;
+-   writes_memory = init;
+  
+    /* Find all the SETs and CLOBBERs in this instruction.
+--- 5999,6002 ----
+*************** cse_insn (insn, in_libcall_block)
+*** 6220,6232 ****
+  	  else if (GET_CODE (y) == CLOBBER)
+  	    {
+! 	      /* If we clobber memory, take note of that,
+! 		 and canon the address.
+  		 This does nothing when a register is clobbered
+  		 because we have already invalidated the reg.  */
+  	      if (GET_CODE (XEXP (y, 0)) == MEM)
+! 		{
+! 		  canon_reg (XEXP (y, 0), NULL_RTX);
+! 		  note_mem_written (XEXP (y, 0), &writes_memory);
+! 		}
+  	    }
+  	  else if (GET_CODE (y) == USE
+--- 6100,6108 ----
+  	  else if (GET_CODE (y) == CLOBBER)
+  	    {
+! 	      /* If we clobber memory, canon the address.
+  		 This does nothing when a register is clobbered
+  		 because we have already invalidated the reg.  */
+  	      if (GET_CODE (XEXP (y, 0)) == MEM)
+! 		canon_reg (XEXP (y, 0), NULL_RTX);
+  	    }
+  	  else if (GET_CODE (y) == USE
+*************** cse_insn (insn, in_libcall_block)
+*** 6247,6254 ****
+      {
+        if (GET_CODE (XEXP (x, 0)) == MEM)
+! 	{
+! 	  canon_reg (XEXP (x, 0), NULL_RTX);
+! 	  note_mem_written (XEXP (x, 0), &writes_memory);
+! 	}
+      }
+  
+--- 6123,6127 ----
+      {
+        if (GET_CODE (XEXP (x, 0)) == MEM)
+! 	canon_reg (XEXP (x, 0), NULL_RTX);
+      }
+  
+*************** cse_insn (insn, in_libcall_block)
+*** 6674,6678 ****
+  	}
+  #endif /* LOAD_EXTEND_OP */
+!  
+        if (src == src_folded)
+          src_folded = 0;
+--- 6547,6551 ----
+  	}
+  #endif /* LOAD_EXTEND_OP */
+! 
+        if (src == src_folded)
+          src_folded = 0;
+*************** cse_insn (insn, in_libcall_block)
+*** 6860,6864 ****
+  		       || (GET_CODE (src_folded) != MEM
+  			   && ! src_folded_force_flag))
+! 		   && GET_MODE_CLASS (mode) != MODE_CC)
+  	    {
+  	      src_folded_force_flag = 1;
+--- 6733,6738 ----
+  		       || (GET_CODE (src_folded) != MEM
+  			   && ! src_folded_force_flag))
+! 		   && GET_MODE_CLASS (mode) != MODE_CC
+! 		   && mode != VOIDmode)
+  	    {
+  	      src_folded_force_flag = 1;
+*************** cse_insn (insn, in_libcall_block)
+*** 6983,6993 ****
+        if (GET_CODE (dest) == MEM)
+  	{
+  	  dest = fold_rtx (dest, insn);
+- 
+- 	  /* Decide whether we invalidate everything in memory,
+- 	     or just things at non-fixed places.
+- 	     Writing a large aggregate must invalidate everything
+- 	     because we don't know how long it is.  */
+- 	  note_mem_written (dest, &writes_memory);
+  	}
+  
+--- 6857,6869 ----
+        if (GET_CODE (dest) == MEM)
+  	{
++ #ifdef PUSH_ROUNDING
++ 	  /* Stack pushes invalidate the stack pointer.  */
++ 	  rtx addr = XEXP (dest, 0);
++ 	  if ((GET_CODE (addr) == PRE_DEC || GET_CODE (addr) == PRE_INC
++ 	       || GET_CODE (addr) == POST_DEC || GET_CODE (addr) == POST_INC)
++ 	      && XEXP (addr, 0) == stack_pointer_rtx)
++ 	    invalidate (stack_pointer_rtx, Pmode);
++ #endif
+  	  dest = fold_rtx (dest, insn);
+  	}
+  
+*************** cse_insn (insn, in_libcall_block)
+*** 7234,7238 ****
+        sets[i].src_elt = src_eqv_elt;
+  
+!   invalidate_from_clobbers (&writes_memory, x);
+  
+    /* Some registers are invalidated by subroutine calls.  Memory is 
+--- 7110,7114 ----
+        sets[i].src_elt = src_eqv_elt;
+  
+!   invalidate_from_clobbers (x);
+  
+    /* Some registers are invalidated by subroutine calls.  Memory is 
+*************** cse_insn (insn, in_libcall_block)
+*** 7241,7248 ****
+    if (GET_CODE (insn) == CALL_INSN)
+      {
+-       static struct write_data everything = {0, 1, 1, 1};
+- 
+        if (! CONST_CALL_P (insn))
+! 	invalidate_memory (&everything);
+        invalidate_for_call ();
+      }
+--- 7117,7122 ----
+    if (GET_CODE (insn) == CALL_INSN)
+      {
+        if (! CONST_CALL_P (insn))
+! 	invalidate_memory ();
+        invalidate_for_call ();
+      }
+*************** cse_insn (insn, in_libcall_block)
+*** 7265,7270 ****
+  	   we have just done an invalidate_memory that covers even those.  */
+  	if (GET_CODE (dest) == REG || GET_CODE (dest) == SUBREG
+! 	    || (GET_CODE (dest) == MEM && ! writes_memory.all
+! 		&& ! cse_rtx_addr_varies_p (dest)))
+  	  invalidate (dest, VOIDmode);
+  	else if (GET_CODE (dest) == STRICT_LOW_PART
+--- 7139,7143 ----
+  	   we have just done an invalidate_memory that covers even those.  */
+  	if (GET_CODE (dest) == REG || GET_CODE (dest) == SUBREG
+! 	    || GET_CODE (dest) == MEM)
+  	  invalidate (dest, VOIDmode);
+  	else if (GET_CODE (dest) == STRICT_LOW_PART
+*************** cse_insn (insn, in_libcall_block)
+*** 7359,7363 ****
+  		      sets[i].dest_hash, GET_MODE (dest));
+  	elt->in_memory = (GET_CODE (sets[i].inner_dest) == MEM
+! 			  && ! RTX_UNCHANGING_P (sets[i].inner_dest));
+  
+  	if (elt->in_memory)
+--- 7232,7238 ----
+  		      sets[i].dest_hash, GET_MODE (dest));
+  	elt->in_memory = (GET_CODE (sets[i].inner_dest) == MEM
+! 			  && (! RTX_UNCHANGING_P (sets[i].inner_dest)
+! 			      || FIXED_BASE_PLUS_P (XEXP (sets[i].inner_dest,
+! 							  0))));
+  
+  	if (elt->in_memory)
+*************** cse_insn (insn, in_libcall_block)
+*** 7532,7580 ****
+  }
+  
+- /* Store 1 in *WRITES_PTR for those categories of memory ref
+-    that must be invalidated when the expression WRITTEN is stored in.
+-    If WRITTEN is null, say everything must be invalidated.  */
+- 
+  static void
+! note_mem_written (written, writes_ptr)
+!      rtx written;
+!      struct write_data *writes_ptr;
+! {
+!   static struct write_data everything = {0, 1, 1, 1};
+! 
+!   if (written == 0)
+!     *writes_ptr = everything;
+!   else if (GET_CODE (written) == MEM)
+!     {
+!       /* Pushing or popping the stack invalidates just the stack pointer. */
+!       rtx addr = XEXP (written, 0);
+!       if ((GET_CODE (addr) == PRE_DEC || GET_CODE (addr) == PRE_INC
+! 	   || GET_CODE (addr) == POST_DEC || GET_CODE (addr) == POST_INC)
+! 	  && GET_CODE (XEXP (addr, 0)) == REG
+! 	  && REGNO (XEXP (addr, 0)) == STACK_POINTER_REGNUM)
+! 	{
+! 	  writes_ptr->sp = 1;
+! 	  return;
+! 	}
+!       else if (GET_MODE (written) == BLKmode)
+! 	*writes_ptr = everything;
+!       /* (mem (scratch)) means clobber everything.  */
+!       else if (GET_CODE (addr) == SCRATCH)
+! 	*writes_ptr = everything;
+!       else if (cse_rtx_addr_varies_p (written))
+! 	{
+! 	  /* A varying address that is a sum indicates an array element,
+! 	     and that's just as good as a structure element
+! 	     in implying that we need not invalidate scalar variables.
+! 	     However, we must allow QImode aliasing of scalars, because the
+! 	     ANSI C standard allows character pointers to alias anything.  */
+! 	  if (! ((MEM_IN_STRUCT_P (written)
+! 		  || GET_CODE (XEXP (written, 0)) == PLUS)
+! 		 && GET_MODE (written) != QImode))
+! 	    writes_ptr->all = 1;
+! 	  writes_ptr->nonscalar = 1;
+! 	}
+!       writes_ptr->var = 1;
+      }
+  }
+  
+--- 7407,7450 ----
+  }
+  
+  static void
+! invalidate_memory ()
+! {
+!   register int i;
+!   register struct table_elt *p, *next;
+! 
+!   for (i = 0; i < NBUCKETS; i++)
+!     for (p = table[i]; p; p = next)
+!       {
+! 	next = p->next_same_hash;
+! 	if (p->in_memory)
+! 	  remove_from_table (p, i);
+!       }
+! }
+! 
+! static int
+! note_mem_written (mem)
+!      register rtx mem;
+! {
+!   if (mem == 0 || GET_CODE(mem) != MEM )
+!      return 0;
+!   else
+!    {
+!       register rtx addr = XEXP (mem, 0);
+!   /* Pushing or popping the stack invalidates just the stack pointer.  */
+!     if ((GET_CODE (addr) == PRE_DEC || GET_CODE (addr) == PRE_INC
+!        || GET_CODE (addr) == POST_DEC || GET_CODE (addr) == POST_INC)
+!       && GET_CODE (XEXP (addr, 0)) == REG
+!       && REGNO (XEXP (addr, 0)) == STACK_POINTER_REGNUM)
+!     {
+!       if (reg_tick[STACK_POINTER_REGNUM] >= 0)
+! 	reg_tick[STACK_POINTER_REGNUM]++;
+! 
+!       /* This should be *very* rare.  */
+!       if (TEST_HARD_REG_BIT (hard_regs_in_table, STACK_POINTER_REGNUM))
+! 	invalidate (stack_pointer_rtx, VOIDmode);
+!       return 1;
+      }
++   return 0;
++   }
+  }
+  
+*************** note_mem_written (written, writes_ptr)
+*** 7584,7612 ****
+     alias with something that is SET or CLOBBERed.
+  
+-    W points to the writes_memory for this insn, a struct write_data
+-    saying which kinds of memory references must be invalidated.
+     X is the pattern of the insn.  */
+  
+  static void
+! invalidate_from_clobbers (w, x)
+!      struct write_data *w;
+       rtx x;
+  {
+-   /* If W->var is not set, W specifies no action.
+-      If W->all is set, this step gets all memory refs
+-      so they can be ignored in the rest of this function.  */
+-   if (w->var)
+-     invalidate_memory (w);
+- 
+-   if (w->sp)
+-     {
+-       if (reg_tick[STACK_POINTER_REGNUM] >= 0)
+- 	reg_tick[STACK_POINTER_REGNUM]++;
+- 
+-       /* This should be *very* rare.  */
+-       if (TEST_HARD_REG_BIT (hard_regs_in_table, STACK_POINTER_REGNUM))
+- 	invalidate (stack_pointer_rtx, VOIDmode);
+-     }
+- 
+    if (GET_CODE (x) == CLOBBER)
+      {
+--- 7454,7463 ----
+     alias with something that is SET or CLOBBERed.
+  
+     X is the pattern of the insn.  */
+  
+  static void
+! invalidate_from_clobbers (x)
+       rtx x;
+  {
+    if (GET_CODE (x) == CLOBBER)
+      {
+*************** invalidate_from_clobbers (w, x)
+*** 7615,7619 ****
+  	{
+  	  if (GET_CODE (ref) == REG || GET_CODE (ref) == SUBREG
+! 	      || (GET_CODE (ref) == MEM && ! w->all))
+  	    invalidate (ref, VOIDmode);
+  	  else if (GET_CODE (ref) == STRICT_LOW_PART
+--- 7466,7470 ----
+  	{
+  	  if (GET_CODE (ref) == REG || GET_CODE (ref) == SUBREG
+! 	      || GET_CODE (ref) == MEM)
+  	    invalidate (ref, VOIDmode);
+  	  else if (GET_CODE (ref) == STRICT_LOW_PART
+*************** invalidate_from_clobbers (w, x)
+*** 7631,7643 ****
+  	    {
+  	      rtx ref = XEXP (y, 0);
+! 	      if (ref)
+! 		{
+! 		  if (GET_CODE (ref) == REG || GET_CODE (ref) == SUBREG
+! 		      || (GET_CODE (ref) == MEM && !w->all))
+! 		    invalidate (ref, VOIDmode);
+! 		  else if (GET_CODE (ref) == STRICT_LOW_PART
+! 			   || GET_CODE (ref) == ZERO_EXTRACT)
+! 		    invalidate (XEXP (ref, 0), GET_MODE (ref));
+! 		}
+  	    }
+  	}
+--- 7482,7491 ----
+  	    {
+  	      rtx ref = XEXP (y, 0);
+! 	      if (GET_CODE (ref) == REG || GET_CODE (ref) == SUBREG
+! 		  || GET_CODE (ref) == MEM)
+! 		invalidate (ref, VOIDmode);
+! 	      else if (GET_CODE (ref) == STRICT_LOW_PART
+! 		       || GET_CODE (ref) == ZERO_EXTRACT)
+! 		invalidate (XEXP (ref, 0), GET_MODE (ref));
+  	    }
+  	}
+*************** cse_around_loop (loop_start)
+*** 7800,7807 ****
+  }
+  
+- /* Variable used for communications between the next two routines.  */
+- 
+- static struct write_data skipped_writes_memory;
+- 
+  /* Process one SET of an insn that was skipped.  We ignore CLOBBERs
+     since they are done elsewhere.  This function is called via note_stores.  */
+--- 7648,7651 ----
+*************** invalidate_skipped_set (dest, set)
+*** 7812,7815 ****
+--- 7656,7675 ----
+       rtx dest;
+  {
++   enum rtx_code code = GET_CODE (dest);
++   
++   if (code == MEM
++       && ! note_mem_written (dest)	/* If this is not a stack push ... */
++       /* There are times when an address can appear varying and be a PLUS
++ 	 during this scan when it would be a fixed address were we to know
++ 	 the proper equivalences.  So invalidate all memory if there is
++ 	 a BLKmode or nonscalar memory reference or a reference to a
++ 	 variable address.  */
++       && (MEM_IN_STRUCT_P (dest) || GET_MODE (dest) == BLKmode
++ 	  || cse_rtx_varies_p (XEXP (dest, 0))))
++     {
++       invalidate_memory ();
++       return;
++     }
++ 
+    if (GET_CODE (set) == CLOBBER
+  #ifdef HAVE_cc0
+*************** invalidate_skipped_set (dest, set)
+*** 7819,7837 ****
+      return;
+  
+!   if (GET_CODE (dest) == MEM)
+!     note_mem_written (dest, &skipped_writes_memory);
+! 
+!   /* There are times when an address can appear varying and be a PLUS
+!      during this scan when it would be a fixed address were we to know
+!      the proper equivalences.  So promote "nonscalar" to be "all".  */
+!   if (skipped_writes_memory.nonscalar)
+!     skipped_writes_memory.all = 1;
+! 
+!   if (GET_CODE (dest) == REG || GET_CODE (dest) == SUBREG
+!       || (! skipped_writes_memory.all && ! cse_rtx_addr_varies_p (dest)))
+!     invalidate (dest, VOIDmode);
+!   else if (GET_CODE (dest) == STRICT_LOW_PART
+! 	   || GET_CODE (dest) == ZERO_EXTRACT)
+      invalidate (XEXP (dest, 0), GET_MODE (dest));
+  }
+  
+--- 7679,7686 ----
+      return;
+  
+!   if (code == STRICT_LOW_PART || code == ZERO_EXTRACT)
+      invalidate (XEXP (dest, 0), GET_MODE (dest));
++   else if (code == REG || code == SUBREG || code == MEM)
++     invalidate (dest, VOIDmode);
+  }
+  
+*************** invalidate_skipped_block (start)
+*** 7845,7850 ****
+  {
+    rtx insn;
+-   static struct write_data init = {0, 0, 0, 0};
+-   static struct write_data everything = {0, 1, 1, 1};
+  
+    for (insn = start; insn && GET_CODE (insn) != CODE_LABEL;
+--- 7694,7697 ----
+*************** invalidate_skipped_block (start)
+*** 7854,7867 ****
+  	continue;
+  
+-       skipped_writes_memory = init;
+- 
+        if (GET_CODE (insn) == CALL_INSN)
+  	{
+  	  invalidate_for_call ();
+- 	  skipped_writes_memory = everything;
+  	}
+  
+        note_stores (PATTERN (insn), invalidate_skipped_set);
+-       invalidate_from_clobbers (&skipped_writes_memory, PATTERN (insn));
+      }
+  }
+--- 7701,7712 ----
+  	continue;
+  
+        if (GET_CODE (insn) == CALL_INSN)
+  	{
++ 	  if (! CONST_CALL_P (insn))
++ 	    invalidate_memory ();
+  	  invalidate_for_call ();
+  	}
+  
+        note_stores (PATTERN (insn), invalidate_skipped_set);
+      }
+  }
+*************** cse_set_around_loop (x, insn, loop_start
+*** 7913,7920 ****
+  {
+    struct table_elt *src_elt;
+-   static struct write_data init = {0, 0, 0, 0};
+-   struct write_data writes_memory;
+- 
+-   writes_memory = init;
+  
+    /* If this is a SET, see if we can replace SET_SRC, but ignore SETs that
+--- 7758,7761 ----
+*************** cse_set_around_loop (x, insn, loop_start
+*** 7976,7991 ****
+  
+    /* Now invalidate anything modified by X.  */
+!   note_mem_written (SET_DEST (x), &writes_memory);
+! 
+!   if (writes_memory.var)
+!     invalidate_memory (&writes_memory);
+! 
+!   /* See comment on similar code in cse_insn for explanation of these tests. */
+    if (GET_CODE (SET_DEST (x)) == REG || GET_CODE (SET_DEST (x)) == SUBREG
+!       || (GET_CODE (SET_DEST (x)) == MEM && ! writes_memory.all
+! 	  && ! cse_rtx_addr_varies_p (SET_DEST (x))))
+      invalidate (SET_DEST (x), VOIDmode);
+    else if (GET_CODE (SET_DEST (x)) == STRICT_LOW_PART
+! 	   || GET_CODE (SET_DEST (x)) == ZERO_EXTRACT)
+      invalidate (XEXP (SET_DEST (x), 0), GET_MODE (SET_DEST (x)));
+  }
+--- 7817,7828 ----
+  
+    /* Now invalidate anything modified by X.  */
+!   note_mem_written (SET_DEST (x));
+!   
+!   /* See comment on similar code in cse_insn for explanation of these tests.  */
+    if (GET_CODE (SET_DEST (x)) == REG || GET_CODE (SET_DEST (x)) == SUBREG
+!       || GET_CODE (SET_DEST (x)) == MEM)
+      invalidate (SET_DEST (x), VOIDmode);
+    else if (GET_CODE (SET_DEST (x)) == STRICT_LOW_PART
+!   	   || GET_CODE (SET_DEST (x)) == ZERO_EXTRACT)
+      invalidate (XEXP (SET_DEST (x), 0), GET_MODE (SET_DEST (x)));
+  }
+*************** cse_main (f, nregs, after_loop, file)
+*** 8234,8237 ****
+--- 8071,8075 ----
+  
+    init_recog ();
++   init_alias_analysis ();
+  
+    max_reg = nregs;
+*************** cse_basic_block (from, to, next_branch, 
+*** 8405,8408 ****
+--- 8243,8247 ----
+    int to_usage = 0;
+    int in_libcall_block = 0;
++   int num_insns = 0;
+  
+    /* Each of these arrays is undefined before max_reg, so only allocate
+*************** cse_basic_block (from, to, next_branch, 
+*** 8437,8440 ****
+--- 8276,8299 ----
+      {
+        register enum rtx_code code;
++       int i;
++       struct table_elt *p, *next;
++ 
++       /* If we have processed 1,000 insns, flush the hash table to avoid
++ 	 extreme quadratic behavior.  */
++       if (num_insns++ > 1000)
++ 	{
++ 	  for (i = 0; i < NBUCKETS; i++)
++ 	    for (p = table[i]; p; p = next)
++ 	      {
++ 		next = p->next_same_hash;
++ 
++ 		if (GET_CODE (p->exp) == REG)
++ 		  invalidate (p->exp, p->mode);
++ 		else
++ 		  remove_from_table (p, i);
++ 	      }
++ 
++ 	  num_insns = 0;
++ 	}
+  
+        /* See if this is a branch that is part of the path.  If so, and it is
+diff -rcp2N gcc-2.7.2.2/dwarfout.c g77-new/dwarfout.c
+*** gcc-2.7.2.2/dwarfout.c	Thu Oct 26 21:40:07 1995
+--- g77-new/dwarfout.c	Sun Aug 10 18:47:19 1997
+*************** output_bound_representation (bound, dim_
+*** 1629,1705 ****
+      {
+  
+!       case ERROR_MARK:
+! 	return;
+  
+        /* All fixed-bounds are represented by INTEGER_CST nodes.	 */
+  
+!       case INTEGER_CST:
+! 	ASM_OUTPUT_DWARF_DATA4 (asm_out_file,
+! 				(unsigned) TREE_INT_CST_LOW (bound));
+! 	break;
+! 
+!       /* Dynamic bounds may be represented by NOP_EXPR nodes containing
+! 	 SAVE_EXPR nodes.  */
+! 
+!       case NOP_EXPR:
+! 	bound = TREE_OPERAND (bound, 0);
+! 	/* ... fall thru... */
+! 
+!       case SAVE_EXPR:
+! 	{
+! 	  char begin_label[MAX_ARTIFICIAL_LABEL_BYTES];
+! 	  char end_label[MAX_ARTIFICIAL_LABEL_BYTES];
+! 
+! 	  sprintf (begin_label, BOUND_BEGIN_LABEL_FMT,
+! 				current_dienum, dim_num, u_or_l);
+  
+! 	  sprintf (end_label,	BOUND_END_LABEL_FMT,
+! 				current_dienum, dim_num, u_or_l);
+  
+! 	  ASM_OUTPUT_DWARF_DELTA2 (asm_out_file, end_label, begin_label);
+! 	  ASM_OUTPUT_LABEL (asm_out_file, begin_label);
+  
+! 	  /* If we are working on a bound for a dynamic dimension in C,
+! 	     the dynamic dimension in question had better have a static
+! 	     (zero) lower bound and a dynamic *upper* bound.  */
+  
+! 	  if (u_or_l != 'u')
+! 	    abort ();
+  
+! 	  /* If optimization is turned on, the SAVE_EXPRs that describe
+! 	     how to access the upper bound values are essentially bogus.
+! 	     They only describe (at best) how to get at these values at
+! 	     the points in the generated code right after they have just
+! 	     been computed.  Worse yet, in the typical case, the upper
+! 	     bound values will not even *be* computed in the optimized
+! 	     code, so these SAVE_EXPRs are entirely bogus.
+! 
+! 	     In order to compensate for this fact, we check here to see
+! 	     if optimization is enabled, and if so, we effectively create
+! 	     an empty location description for the (unknown and unknowable)
+! 	     upper bound.
+! 
+! 	     This should not cause too much trouble for existing (stupid?)
+! 	     debuggers because they have to deal with empty upper bounds
+! 	     location descriptions anyway in order to be able to deal with
+! 	     incomplete array types.
+! 
+! 	     Of course an intelligent debugger (GDB?) should be able to
+! 	     comprehend that a missing upper bound specification in a
+! 	     array type used for a storage class `auto' local array variable
+! 	     indicates that the upper bound is both unknown (at compile-
+! 	     time) and unknowable (at run-time) due to optimization.
+! 	  */
+! 
+! 	  if (! optimize)
+! 	    output_loc_descriptor
+! 	      (eliminate_regs (SAVE_EXPR_RTL (bound), 0, NULL_RTX));
+  
+! 	  ASM_OUTPUT_LABEL (asm_out_file, end_label);
+! 	}
+! 	break;
+  
+-       default:
+- 	abort ();
+      }
+  }
+--- 1629,1699 ----
+      {
+  
+!     case ERROR_MARK:
+!       return;
+  
+        /* All fixed-bounds are represented by INTEGER_CST nodes.	 */
+  
+!     case INTEGER_CST:
+!       ASM_OUTPUT_DWARF_DATA4 (asm_out_file,
+! 			      (unsigned) TREE_INT_CST_LOW (bound));
+!       break;
+  
+!     default:
+  
+!       /* Dynamic bounds may be represented by NOP_EXPR nodes containing
+! 	 SAVE_EXPR nodes, in which case we can do something, or as
+! 	 an expression, which we cannot represent.  */
+!       {
+! 	char begin_label[MAX_ARTIFICIAL_LABEL_BYTES];
+! 	char end_label[MAX_ARTIFICIAL_LABEL_BYTES];
+  
+! 	sprintf (begin_label, BOUND_BEGIN_LABEL_FMT,
+! 		 current_dienum, dim_num, u_or_l);
+  
+! 	sprintf (end_label, BOUND_END_LABEL_FMT,
+! 		 current_dienum, dim_num, u_or_l);
+  
+! 	ASM_OUTPUT_DWARF_DELTA2 (asm_out_file, end_label, begin_label);
+! 	ASM_OUTPUT_LABEL (asm_out_file, begin_label);
+! 
+! 	/* If optimization is turned on, the SAVE_EXPRs that describe
+! 	   how to access the upper bound values are essentially bogus.
+! 	   They only describe (at best) how to get at these values at
+! 	   the points in the generated code right after they have just
+! 	   been computed.  Worse yet, in the typical case, the upper
+! 	   bound values will not even *be* computed in the optimized
+! 	   code, so these SAVE_EXPRs are entirely bogus.
+! 
+! 	   In order to compensate for this fact, we check here to see
+! 	   if optimization is enabled, and if so, we effectively create
+! 	   an empty location description for the (unknown and unknowable)
+! 	   upper bound.
+! 
+! 	   This should not cause too much trouble for existing (stupid?)
+! 	   debuggers because they have to deal with empty upper bounds
+! 	   location descriptions anyway in order to be able to deal with
+! 	   incomplete array types.
+! 
+! 	   Of course an intelligent debugger (GDB?) should be able to
+! 	   comprehend that a missing upper bound specification in a
+! 	   array type used for a storage class `auto' local array variable
+! 	   indicates that the upper bound is both unknown (at compile-
+! 	   time) and unknowable (at run-time) due to optimization. */
+! 
+! 	if (! optimize)
+! 	  {
+! 	    while (TREE_CODE (bound) == NOP_EXPR
+! 		   || TREE_CODE (bound) == CONVERT_EXPR)
+! 	      bound = TREE_OPERAND (bound, 0);
+! 
+! 	    if (TREE_CODE (bound) == SAVE_EXPR)
+! 	      output_loc_descriptor
+! 		(eliminate_regs (SAVE_EXPR_RTL (bound), 0, NULL_RTX));
+! 	  }
+  
+! 	ASM_OUTPUT_LABEL (asm_out_file, end_label);
+!       }
+!       break;
+  
+      }
+  }
+*************** type_attribute (type, decl_const, decl_v
+*** 2857,2861 ****
+    register int root_type_modified;
+  
+!   if (TREE_CODE (type) == ERROR_MARK)
+      return;
+  
+--- 2851,2855 ----
+    register int root_type_modified;
+  
+!   if (code == ERROR_MARK)
+      return;
+  
+*************** type_attribute (type, decl_const, decl_v
+*** 2864,2869 ****
+       type `void', so this only applies to function return types.  */
+  
+!   if (TREE_CODE (type) == VOID_TYPE)
+      return;
+  
+    root_type_modified = (code == POINTER_TYPE || code == REFERENCE_TYPE
+--- 2858,2869 ----
+       type `void', so this only applies to function return types.  */
+  
+!   if (code == VOID_TYPE)
+      return;
++ 
++   /* If this is a subtype, find the underlying type.  Eventually,
++      this should write out the appropriate subtype info.  */
++   while ((code == INTEGER_TYPE || code == REAL_TYPE)
++ 	 && TREE_TYPE (type) != 0)
++     type = TREE_TYPE (type), code = TREE_CODE (type);
+  
+    root_type_modified = (code == POINTER_TYPE || code == REFERENCE_TYPE
+diff -rcp2N gcc-2.7.2.2/emit-rtl.c g77-new/emit-rtl.c
+*** gcc-2.7.2.2/emit-rtl.c	Thu Sep 14 16:09:30 1995
+--- g77-new/emit-rtl.c	Sun Aug 10 18:47:08 1997
+*************** max_label_num ()
+*** 545,548 ****
+--- 545,565 ----
+  }
+  
++ /* Identify REG (which may be a CONCAT) as a user register.  */
++ 
++ void
++ mark_user_reg (reg)
++      rtx reg;
++ {
++   if (GET_CODE (reg) == CONCAT)
++     {
++       REG_USERVAR_P (XEXP (reg, 0)) = 1;
++       REG_USERVAR_P (XEXP (reg, 1)) = 1;
++     }
++   else if (GET_CODE (reg) == REG)
++     REG_USERVAR_P (reg) = 1;
++   else
++     abort ();
++ }
++ 
+  /* Return first label number used in this function (if any were used).  */
+  
+*************** change_address (memref, mode, addr)
+*** 1315,1318 ****
+--- 1332,1338 ----
+      addr = memory_address (mode, addr);
+  	
++   if (rtx_equal_p (addr, XEXP (memref, 0)) && mode == GET_MODE (memref))
++     return memref;
++ 
+    new = gen_rtx (MEM, mode, addr);
+    MEM_VOLATILE_P (new) = MEM_VOLATILE_P (memref);
+diff -rcp2N gcc-2.7.2.2/explow.c g77-new/explow.c
+*** gcc-2.7.2.2/explow.c	Thu Jun 15 07:30:10 1995
+--- g77-new/explow.c	Sun Aug 10 18:46:30 1997
+*************** convert_memory_address (to_mode, x)
+*** 305,310 ****
+--- 305,313 ----
+       rtx x;
+  {
++   enum machine_mode from_mode = to_mode == ptr_mode ? Pmode : ptr_mode;
+    rtx temp;
+  
++   /* Here we handle some special cases.  If none of them apply, fall through
++      to the default case.  */
+    switch (GET_CODE (x))
+      {
+*************** convert_memory_address (to_mode, x)
+*** 321,339 ****
+        return temp;
+  
+-     case PLUS:
+-     case MULT:
+-       return gen_rtx (GET_CODE (x), to_mode, 
+- 		      convert_memory_address (to_mode, XEXP (x, 0)),
+- 		      convert_memory_address (to_mode, XEXP (x, 1)));
+- 
+      case CONST:
+        return gen_rtx (CONST, to_mode, 
+  		      convert_memory_address (to_mode, XEXP (x, 0)));
+  
+!     default:
+!       return convert_modes (to_mode,
+! 			    to_mode == ptr_mode ? Pmode : ptr_mode,
+! 			    x, POINTERS_EXTEND_UNSIGNED);
+      }
+  }
+  #endif
+--- 324,348 ----
+        return temp;
+  
+      case CONST:
+        return gen_rtx (CONST, to_mode, 
+  		      convert_memory_address (to_mode, XEXP (x, 0)));
+  
+!     case PLUS:
+!     case MULT:
+!       /* For addition the second operand is a small constant, we can safely
+! 	 permute the converstion and addition operation.  We can always safely
+! 	 permute them if we are making the address narrower.  In addition,
+! 	 always permute the operations if this is a constant.  */
+!       if (GET_MODE_SIZE (to_mode) < GET_MODE_SIZE (from_mode)
+! 	  || (GET_CODE (x) == PLUS && GET_CODE (XEXP (x, 1)) == CONST_INT
+! 	      && (INTVAL (XEXP (x, 1)) + 20000 < 40000
+! 		  || CONSTANT_P (XEXP (x, 0)))))
+! 	return gen_rtx (GET_CODE (x), to_mode, 
+! 			convert_memory_address (to_mode, XEXP (x, 0)),
+! 			convert_memory_address (to_mode, XEXP (x, 1)));
+      }
++ 
++   return convert_modes (to_mode, from_mode,
++ 			x, POINTERS_EXTEND_UNSIGNED);
+  }
+  #endif
+diff -rcp2N gcc-2.7.2.2/expmed.c g77-new/expmed.c
+*** gcc-2.7.2.2/expmed.c	Thu Jul 13 19:25:37 1995
+--- g77-new/expmed.c	Sun Aug 10 18:46:23 1997
+*************** store_bit_field (str_rtx, bitsize, bitnu
+*** 399,402 ****
+--- 399,403 ----
+  #ifdef HAVE_insv
+    if (HAVE_insv
++       && GET_MODE (value) != BLKmode
+        && !(bitsize == 1 && GET_CODE (value) == CONST_INT)
+        /* Ensure insv's size is wide enough for this field.  */
+*************** store_split_bit_field (op0, bitsize, bit
+*** 777,781 ****
+  	     done in extract_bit_field, so that the two calls to
+  	     extract_fixed_bit_field will have comparable arguments.  */
+! 	  if (GET_CODE (value) != MEM)
+  	    total_bits = BITS_PER_WORD;
+  	  else
+--- 778,782 ----
+  	     done in extract_bit_field, so that the two calls to
+  	     extract_fixed_bit_field will have comparable arguments.  */
+! 	  if (GET_CODE (value) != MEM || GET_MODE (value) == BLKmode)
+  	    total_bits = BITS_PER_WORD;
+  	  else
+*************** store_split_bit_field (op0, bitsize, bit
+*** 790,797 ****
+  	    /* The args are chosen so that the last part includes the
+  	       lsb.  Give extract_bit_field the value it needs (with
+! 	       endianness compensation) to fetch the piece we want.  */
+! 	    part = extract_fixed_bit_field (word_mode, value, 0, thissize,
+! 					    total_bits - bitsize + bitsdone,
+! 					    NULL_RTX, 1, align);
+  	}
+        else
+--- 791,807 ----
+  	    /* The args are chosen so that the last part includes the
+  	       lsb.  Give extract_bit_field the value it needs (with
+! 	       endianness compensation) to fetch the piece we want.
+! 
+! 	       ??? We have no idea what the alignment of VALUE is, so
+! 	       we have to use a guess.  */
+! 	    part
+! 	      = extract_fixed_bit_field
+! 		(word_mode, value, 0, thissize,
+! 		 total_bits - bitsize + bitsdone, NULL_RTX, 1,
+! 		 GET_MODE (value) == VOIDmode
+! 		 ? UNITS_PER_WORD
+! 		 : (GET_MODE (value) == BLKmode
+! 		    ? 1
+! 		    : GET_MODE_ALIGNMENT (GET_MODE (value)) / BITS_PER_UNIT));
+  	}
+        else
+*************** store_split_bit_field (op0, bitsize, bit
+*** 803,808 ****
+  			    & (((HOST_WIDE_INT) 1 << thissize) - 1));
+  	  else
+! 	    part = extract_fixed_bit_field (word_mode, value, 0, thissize,
+! 					    bitsdone, NULL_RTX, 1, align);
+  	}
+  
+--- 813,824 ----
+  			    & (((HOST_WIDE_INT) 1 << thissize) - 1));
+  	  else
+! 	    part
+! 	      = extract_fixed_bit_field
+! 		(word_mode, value, 0, thissize, bitsdone, NULL_RTX, 1,
+! 		 GET_MODE (value) == VOIDmode
+! 		 ? UNITS_PER_WORD
+! 		 : (GET_MODE (value) == BLKmode
+! 		    ? 1
+! 		    : GET_MODE_ALIGNMENT (GET_MODE (value)) / BITS_PER_UNIT));
+  	}
+  
+*************** extract_bit_field (str_rtx, bitsize, bit
+*** 876,882 ****
+    rtx spec_target_subreg = 0;
+  
+-   if (GET_CODE (str_rtx) == MEM && ! MEM_IN_STRUCT_P (str_rtx))
+-     abort ();
+- 
+    /* Discount the part of the structure before the desired byte.
+       We need to know how many bytes are safe to reference after it.  */
+--- 892,895 ----
+*************** expand_divmod (rem_flag, code, mode, op0
+*** 3189,3193 ****
+  	   Notice that we compute also the final remainder value here,
+  	   and return the result right away.  */
+! 	if (target == 0)
+  	  target = gen_reg_rtx (compute_mode);
+  
+--- 3202,3206 ----
+  	   Notice that we compute also the final remainder value here,
+  	   and return the result right away.  */
+! 	if (target == 0 || GET_MODE (target) != compute_mode)
+  	  target = gen_reg_rtx (compute_mode);
+  
+*************** expand_divmod (rem_flag, code, mode, op0
+*** 3316,3320 ****
+  	       remainder.  Notice that we compute also the final remainder
+  	       value here, and return the result right away.  */
+! 	    if (target == 0)
+  	      target = gen_reg_rtx (compute_mode);
+  
+--- 3329,3333 ----
+  	       remainder.  Notice that we compute also the final remainder
+  	       value here, and return the result right away.  */
+! 	    if (target == 0 || GET_MODE (target) != compute_mode)
+  	      target = gen_reg_rtx (compute_mode);
+  
+*************** expand_divmod (rem_flag, code, mode, op0
+*** 3418,3422 ****
+  	       remainder.  Notice that we compute also the final remainder
+  	       value here, and return the result right away.  */
+! 	    if (target == 0)
+  	      target = gen_reg_rtx (compute_mode);
+  	    if (rem_flag)
+--- 3431,3435 ----
+  	       remainder.  Notice that we compute also the final remainder
+  	       value here, and return the result right away.  */
+! 	    if (target == 0 || GET_MODE (target) != compute_mode)
+  	      target = gen_reg_rtx (compute_mode);
+  	    if (rem_flag)
+*************** expand_divmod (rem_flag, code, mode, op0
+*** 3602,3605 ****
+--- 3615,3621 ----
+    if (quotient == 0)
+      {
++       if (target && GET_MODE (target) != compute_mode)
++ 	target = 0;
++ 
+        if (rem_flag)
+  	{
+*************** expand_divmod (rem_flag, code, mode, op0
+*** 3653,3656 ****
+--- 3669,3675 ----
+    if (rem_flag)
+      {
++       if (target && GET_MODE (target) != compute_mode)
++ 	target = 0;
++ 
+        if (quotient == 0)
+  	/* No divide instruction either.  Use library for remainder.  */
+diff -rcp2N gcc-2.7.2.2/expr.c g77-new/expr.c
+*** gcc-2.7.2.2/expr.c	Thu Feb 20 19:24:17 1997
+--- g77-new/expr.c	Sun Aug 10 18:47:21 1997
+*************** Boston, MA 02111-1307, USA.  */
+*** 27,30 ****
+--- 27,31 ----
+  #include "flags.h"
+  #include "regs.h"
++ #include "hard-reg-set.h"
+  #include "function.h"
+  #include "insn-flags.h"
+*************** extern int stack_depth;
+*** 139,143 ****
+  extern int max_stack_depth;
+  extern struct obstack permanent_obstack;
+! 
+  
+  static rtx enqueue_insn		PROTO((rtx, rtx));
+--- 140,144 ----
+  extern int max_stack_depth;
+  extern struct obstack permanent_obstack;
+! extern rtx arg_pointer_save_area;
+  
+  static rtx enqueue_insn		PROTO((rtx, rtx));
+*************** expand_assignment (to, from, want_value,
+*** 2498,2503 ****
+  
+        push_temp_slots ();
+!       tem = get_inner_reference (to, &bitsize, &bitpos, &offset,
+! 				      &mode1, &unsignedp, &volatilep);
+  
+        /* If we are going to use store_bit_field and extract_bit_field,
+--- 2499,2504 ----
+  
+        push_temp_slots ();
+!       tem = get_inner_reference (to, &bitsize, &bitpos, &offset, &mode1,
+! 				 &unsignedp, &volatilep, &alignment);
+  
+        /* If we are going to use store_bit_field and extract_bit_field,
+*************** expand_assignment (to, from, want_value,
+*** 2507,2511 ****
+  	tem = stabilize_reference (tem);
+  
+-       alignment = TYPE_ALIGN (TREE_TYPE (tem)) / BITS_PER_UNIT;
+        to_rtx = expand_expr (tem, NULL_RTX, VOIDmode, 0);
+        if (offset != 0)
+--- 2508,2511 ----
+*************** expand_assignment (to, from, want_value,
+*** 2518,2529 ****
+  				   gen_rtx (PLUS, ptr_mode, XEXP (to_rtx, 0),
+  					    force_reg (ptr_mode, offset_rtx)));
+- 	  /* If we have a variable offset, the known alignment
+- 	     is only that of the innermost structure containing the field.
+- 	     (Actually, we could sometimes do better by using the
+- 	     align of an element of the innermost array, but no need.)  */
+- 	  if (TREE_CODE (to) == COMPONENT_REF
+- 	      || TREE_CODE (to) == BIT_FIELD_REF)
+- 	    alignment
+- 	      = TYPE_ALIGN (TREE_TYPE (TREE_OPERAND (to, 0))) / BITS_PER_UNIT;
+  	}
+        if (volatilep)
+--- 2518,2521 ----
+*************** store_expr (exp, target, want_value)
+*** 2775,2780 ****
+  	 which will often result in some optimizations.  Do the conversion
+  	 in two steps: first change the signedness, if needed, then
+! 	 the extend.  */
+!       if (! want_value)
+  	{
+  	  if (TREE_UNSIGNED (TREE_TYPE (exp))
+--- 2767,2775 ----
+  	 which will often result in some optimizations.  Do the conversion
+  	 in two steps: first change the signedness, if needed, then
+! 	 the extend.  But don't do this if the type of EXP is a subtype
+! 	 of something else since then the conversion might involve
+! 	 more than just converting modes.  */
+!       if (! want_value && INTEGRAL_TYPE_P (TREE_TYPE (exp))
+! 	  && TREE_TYPE (TREE_TYPE (exp)) == 0)
+  	{
+  	  if (TREE_UNSIGNED (TREE_TYPE (exp))
+*************** store_constructor (exp, target)
+*** 3071,3074 ****
+--- 3066,3077 ----
+  	    }
+  
++ 	  if (TREE_READONLY (field))
++ 	    {
++ 	      if (GET_CODE (to_rtx) == MEM)
++ 		to_rtx = change_address (to_rtx, GET_MODE (to_rtx),
++ 					 XEXP (to_rtx, 0));
++ 	      RTX_UNCHANGING_P (to_rtx) = 1;
++ 	    }
++ 
+  	  store_field (to_rtx, bitsize, bitpos, mode, TREE_VALUE (elt),
+  		       /* The alignment of TARGET is
+*************** store_field (target, bitsize, bitpos, mo
+*** 3414,3417 ****
+--- 3417,3432 ----
+        rtx temp = expand_expr (exp, NULL_RTX, VOIDmode, 0);
+  
++       /* If BITSIZE is narrower than the size of the type of EXP
++ 	 we will be narrowing TEMP.  Normally, what's wanted are the
++ 	 low-order bits.  However, if EXP's type is a record and this is
++ 	 big-endian machine, we want the upper BITSIZE bits.  */
++       if (BYTES_BIG_ENDIAN && GET_MODE_CLASS (GET_MODE (temp)) == MODE_INT
++ 	  && bitsize < GET_MODE_BITSIZE (GET_MODE (temp))
++ 	  && TREE_CODE (TREE_TYPE (exp)) == RECORD_TYPE)
++ 	temp = expand_shift (RSHIFT_EXPR, GET_MODE (temp), temp,
++ 			     size_int (GET_MODE_BITSIZE (GET_MODE (temp))
++ 				       - bitsize),
++ 			     temp, 1);
++ 
+        /* Unless MODE is VOIDmode or BLKmode, convert TEMP to
+  	 MODE.  */
+*************** store_field (target, bitsize, bitpos, mo
+*** 3420,3423 ****
+--- 3435,3459 ----
+  	temp = convert_modes (mode, TYPE_MODE (TREE_TYPE (exp)), temp, 1);
+  
++       /* If the modes of TARGET and TEMP are both BLKmode, both
++ 	 must be in memory and BITPOS must be aligned on a byte
++ 	 boundary.  If so, we simply do a block copy.  */
++       if (GET_MODE (target) == BLKmode && GET_MODE (temp) == BLKmode)
++ 	{
++ 	  if (GET_CODE (target) != MEM || GET_CODE (temp) != MEM
++ 	      || bitpos % BITS_PER_UNIT != 0)
++ 	    abort ();
++ 
++ 	  target = change_address (target, VOIDmode,
++ 				   plus_constant (XEXP (target, 0),
++ 						  bitpos / BITS_PER_UNIT));
++ 
++ 	  emit_block_move (target, temp,
++ 			   GEN_INT ((bitsize + BITS_PER_UNIT - 1)
++ 				    / BITS_PER_UNIT),
++ 			   1);
++ 
++ 	  return value_mode == VOIDmode ? const0_rtx : target;
++ 	}
++ 
+        /* Store the value in the bitfield.  */
+        store_bit_field (target, bitsize, bitpos, mode, temp, align, total_size);
+*************** get_inner_unaligned_p (exp)
+*** 3515,3518 ****
+--- 3551,3557 ----
+     This offset is in addition to the bit position.
+     If the position is not variable, we store 0 in *POFFSET.
++    We set *PALIGNMENT to the alignment in bytes of the address that will be
++    computed.  This is the alignment of the thing we return if *POFFSET
++    is zero, but can be more less strictly aligned if *POFFSET is nonzero.
+  
+     If any of the extraction expressions is volatile,
+*************** get_inner_unaligned_p (exp)
+*** 3525,3533 ****
+     If the field describes a variable-sized object, *PMODE is set to
+     VOIDmode and *PBITSIZE is set to -1.  An access cannot be made in
+!    this case, but the address of the object can be found.  */
+  
+  tree
+  get_inner_reference (exp, pbitsize, pbitpos, poffset, pmode,
+! 		     punsignedp, pvolatilep)
+       tree exp;
+       int *pbitsize;
+--- 3564,3572 ----
+     If the field describes a variable-sized object, *PMODE is set to
+     VOIDmode and *PBITSIZE is set to -1.  An access cannot be made in
+!    this case, but the address of the object can be found.   */
+  
+  tree
+  get_inner_reference (exp, pbitsize, pbitpos, poffset, pmode,
+! 		     punsignedp, pvolatilep, palignment)
+       tree exp;
+       int *pbitsize;
+*************** get_inner_reference (exp, pbitsize, pbit
+*** 3537,3540 ****
+--- 3576,3580 ----
+       int *punsignedp;
+       int *pvolatilep;
++      int *palignment;
+  {
+    tree orig_exp = exp;
+*************** get_inner_reference (exp, pbitsize, pbit
+*** 3542,3545 ****
+--- 3582,3586 ----
+    enum machine_mode mode = VOIDmode;
+    tree offset = integer_zero_node;
++   int alignment = BIGGEST_ALIGNMENT;
+  
+    if (TREE_CODE (exp) == COMPONENT_REF)
+*************** get_inner_reference (exp, pbitsize, pbit
+*** 3599,3607 ****
+  
+  	  *pbitpos += TREE_INT_CST_LOW (constant);
+! 
+! 	  if (var)
+! 	    offset = size_binop (PLUS_EXPR, offset,
+! 				 size_binop (EXACT_DIV_EXPR, var,
+! 					     size_int (BITS_PER_UNIT)));
+  	}
+  
+--- 3640,3646 ----
+  
+  	  *pbitpos += TREE_INT_CST_LOW (constant);
+! 	  offset = size_binop (PLUS_EXPR, offset,
+! 			       size_binop (EXACT_DIV_EXPR, var,
+! 					   size_int (BITS_PER_UNIT)));
+  	}
+  
+*************** get_inner_reference (exp, pbitsize, pbit
+*** 3629,3633 ****
+  
+  	  index = fold (build (MULT_EXPR, index_type, index,
+! 			       TYPE_SIZE (TREE_TYPE (exp))));
+  
+  	  if (TREE_CODE (index) == INTEGER_CST
+--- 3668,3673 ----
+  
+  	  index = fold (build (MULT_EXPR, index_type, index,
+! 			       convert (index_type,
+! 					TYPE_SIZE (TREE_TYPE (exp)))));
+  
+  	  if (TREE_CODE (index) == INTEGER_CST
+*************** get_inner_reference (exp, pbitsize, pbit
+*** 3652,3666 ****
+        if (TREE_THIS_VOLATILE (exp))
+  	*pvolatilep = 1;
+        exp = TREE_OPERAND (exp, 0);
+      }
+  
+!   /* If this was a bit-field, see if there is a mode that allows direct
+!      access in case EXP is in memory.  */
+!   if (mode == VOIDmode && *pbitsize != 0 && *pbitpos % *pbitsize == 0)
+!     {
+!       mode = mode_for_size (*pbitsize, MODE_INT, 0);
+!       if (mode == BLKmode)
+! 	mode = VOIDmode;
+!     }
+  
+    if (integer_zerop (offset))
+--- 3692,3708 ----
+        if (TREE_THIS_VOLATILE (exp))
+  	*pvolatilep = 1;
++ 
++       /* If the offset is non-constant already, then we can't assume any
++ 	 alignment more than the alignment here.  */
++       if (! integer_zerop (offset))
++ 	alignment = MIN (alignment, TYPE_ALIGN (TREE_TYPE (exp)));
++ 
+        exp = TREE_OPERAND (exp, 0);
+      }
+  
+!   if (TREE_CODE_CLASS (TREE_CODE (exp)) == 'd')
+!     alignment = MIN (alignment, DECL_ALIGN (exp));
+!   else if (TREE_TYPE (exp) != 0)
+!     alignment = MIN (alignment, TYPE_ALIGN (TREE_TYPE (exp)));
+  
+    if (integer_zerop (offset))
+*************** get_inner_reference (exp, pbitsize, pbit
+*** 3672,3675 ****
+--- 3714,3718 ----
+    *pmode = mode;
+    *poffset = offset;
++   *palignment = alignment / BITS_PER_UNIT;
+    return exp;
+  }
+*************** init_noncopied_parts (lhs, list)
+*** 3812,3820 ****
+  }
+  
+! /* Subroutine of expand_expr: return nonzero iff there is no way that
+     EXP can reference X, which is being modified.  */
+  
+  static int
+! safe_from_p (x, exp)
+       rtx x;
+       tree exp;
+--- 3855,3867 ----
+  }
+  
+! static int safe_from_p_count;
+! static int safe_from_p_size;
+! static tree *safe_from_p_rewritten;
+! 
+! /* Subroutine of safe_from_p: return nonzero iff there is no way that
+     EXP can reference X, which is being modified.  */
+  
+  static int
+! safe_from_p_1 (x, exp)
+       rtx x;
+       tree exp;
+*************** safe_from_p (x, exp)
+*** 3822,3825 ****
+--- 3869,3873 ----
+    rtx exp_rtl = 0;
+    int i, nops;
++   int is_save_expr = 0;
+  
+    if (x == 0
+*************** safe_from_p (x, exp)
+*** 3860,3878 ****
+  
+      case 'x':
+!       if (TREE_CODE (exp) == TREE_LIST)
+! 	return ((TREE_VALUE (exp) == 0
+! 		 || safe_from_p (x, TREE_VALUE (exp)))
+! 		&& (TREE_CHAIN (exp) == 0
+! 		    || safe_from_p (x, TREE_CHAIN (exp))));
+!       else
+! 	return 0;
+  
+      case '1':
+!       return safe_from_p (x, TREE_OPERAND (exp, 0));
+  
+      case '2':
+      case '<':
+!       return (safe_from_p (x, TREE_OPERAND (exp, 0))
+! 	      && safe_from_p (x, TREE_OPERAND (exp, 1)));
+  
+      case 'e':
+--- 3908,3933 ----
+  
+      case 'x':
+!       switch (TREE_CODE (exp))
+! 	{
+! 	case TREE_LIST:
+! 	  return ((TREE_VALUE (exp) == 0
+! 		   || safe_from_p_1 (x, TREE_VALUE (exp)))
+! 		  && (TREE_CHAIN (exp) == 0
+! 		      || safe_from_p_1 (x, TREE_CHAIN (exp))));
+! 
+! 	case ERROR_MARK:
+! 	  return 1;
+! 
+! 	default:
+! 	  return 0;
+! 	}
+  
+      case '1':
+!       return safe_from_p_1 (x, TREE_OPERAND (exp, 0));
+  
+      case '2':
+      case '<':
+!       return (safe_from_p_1 (x, TREE_OPERAND (exp, 0))
+! 	      && safe_from_p_1 (x, TREE_OPERAND (exp, 1)));
+  
+      case 'e':
+*************** safe_from_p (x, exp)
+*** 3887,3891 ****
+  	case ADDR_EXPR:
+  	  return (staticp (TREE_OPERAND (exp, 0))
+! 		  || safe_from_p (x, TREE_OPERAND (exp, 0)));
+  
+  	case INDIRECT_REF:
+--- 3942,3946 ----
+  	case ADDR_EXPR:
+  	  return (staticp (TREE_OPERAND (exp, 0))
+! 		  || safe_from_p_1 (x, TREE_OPERAND (exp, 0)));
+  
+  	case INDIRECT_REF:
+*************** safe_from_p (x, exp)
+*** 3922,3928 ****
+  
+  	case CLEANUP_POINT_EXPR:
+! 	  return safe_from_p (x, TREE_OPERAND (exp, 0));
+  
+  	case SAVE_EXPR:
+  	  exp_rtl = SAVE_EXPR_RTL (exp);
+  	  break;
+--- 3977,3984 ----
+  
+  	case CLEANUP_POINT_EXPR:
+! 	  return safe_from_p_1 (x, TREE_OPERAND (exp, 0));
+  
+  	case SAVE_EXPR:
++ 	  is_save_expr = 1;
+  	  exp_rtl = SAVE_EXPR_RTL (exp);
+  	  break;
+*************** safe_from_p (x, exp)
+*** 3931,3935 ****
+  	  /* The only operand we look at is operand 1.  The rest aren't
+  	     part of the expression.  */
+! 	  return safe_from_p (x, TREE_OPERAND (exp, 1));
+  
+  	case METHOD_CALL_EXPR:
+--- 3987,3991 ----
+  	  /* The only operand we look at is operand 1.  The rest aren't
+  	     part of the expression.  */
+! 	  return safe_from_p_1 (x, TREE_OPERAND (exp, 1));
+  
+  	case METHOD_CALL_EXPR:
+*************** safe_from_p (x, exp)
+*** 3945,3949 ****
+        for (i = 0; i < nops; i++)
+  	if (TREE_OPERAND (exp, i) != 0
+! 	    && ! safe_from_p (x, TREE_OPERAND (exp, i)))
+  	  return 0;
+      }
+--- 4001,4005 ----
+        for (i = 0; i < nops; i++)
+  	if (TREE_OPERAND (exp, i) != 0
+! 	    && ! safe_from_p_1 (x, TREE_OPERAND (exp, i)))
+  	  return 0;
+      }
+*************** safe_from_p (x, exp)
+*** 3969,3975 ****
+--- 4025,4087 ----
+  
+    /* If we reach here, it is safe.  */
++   if (is_save_expr)
++     {
++       /* This SAVE_EXPR might appear many times in the top-level
++ 	 safe_from_p() expression, and if it has a complex
++ 	 subexpression, examining it multiple times could result
++ 	 in a combinatorial explosion.  E.g. on an Alpha Cabriolet
++ 	 running at least 200MHz, a Fortran test case compiled with
++ 	 optimization took about 28 minutes to compile -- even though
++ 	 it was only a few lines long, and the complicated line causing
++ 	 so much time to be spent in the earlier version of safe_from_p()
++ 	 had only 293 or so unique nodes.
++ 
++ 	 So, turn this SAVE_EXPR into an ERROR_MARK for now, but remember
++ 	 where it is so we can turn it back in the top-level safe_from_p()
++ 	 when we're done.  */
++ 
++       if (safe_from_p_count > safe_from_p_size)
++ 	return 0;	/* For now, don't bother re-sizing the array. */
++       safe_from_p_rewritten[safe_from_p_count++] = exp;
++       TREE_SET_CODE (exp, ERROR_MARK);
++     }
++ 
+    return 1;
+  }
+  
++ /* Subroutine of expand_expr: return nonzero iff there is no way that
++    EXP can reference X, which is being modified.  */
++ 
++ static int
++ safe_from_p (x, exp)
++      rtx x;
++      tree exp;
++ {
++   int rtn;
++   int i;
++   tree trees[128];
++ 
++   safe_from_p_count = 0;
++   safe_from_p_size = sizeof (trees) / sizeof (trees[0]);
++   safe_from_p_rewritten = &trees[0];
++ 
++   rtn = safe_from_p_1 (x, exp);
++ 
++ #if 0
++   if (safe_from_p_count != 0)
++     fprintf (stderr, "%s:%d: safe_from_p_count = %d\n",
++ 	     input_filename, lineno, safe_from_p_count);
++ #endif
++ 
++   for (i = 0; i < safe_from_p_count; ++i)
++     {
++       if (TREE_CODE (trees [i]) != ERROR_MARK)
++ 	abort ();
++       TREE_SET_CODE (trees[i], SAVE_EXPR);
++     }
++ 
++   return rtn;
++ }
++ 
+  /* Subroutine of expand_expr: return nonzero iff EXP is an
+     expression whose type is statically determinable.  */
+*************** expand_expr (exp, target, tmode, modifie
+*** 4534,4537 ****
+--- 4646,4658 ----
+  		}
+  	    }
++ 
++ 	  if (TREE_READONLY (exp))
++ 	    {
++ 	      if (GET_CODE (target) == MEM)
++ 		target = change_address (target, GET_MODE (target),
++ 					 XEXP (target, 0));
++ 	      RTX_UNCHANGING_P (target) = 1;
++ 	    }
++ 
+  	  store_constructor (exp, target);
+  	  return target;
+*************** expand_expr (exp, target, tmode, modifie
+*** 4543,4567 ****
+  	tree exp2;
+  
+! 	/* A SAVE_EXPR as the address in an INDIRECT_EXPR is generated
+! 	   for  *PTR += ANYTHING  where PTR is put inside the SAVE_EXPR.
+! 	   This code has the same general effect as simply doing
+! 	   expand_expr on the save expr, except that the expression PTR
+! 	   is computed for use as a memory address.  This means different
+! 	   code, suitable for indexing, may be generated.  */
+! 	if (TREE_CODE (exp1) == SAVE_EXPR
+! 	    && SAVE_EXPR_RTL (exp1) == 0
+! 	    && TYPE_MODE (TREE_TYPE (exp1)) == ptr_mode)
+! 	  {
+! 	    temp = expand_expr (TREE_OPERAND (exp1, 0), NULL_RTX,
+! 				VOIDmode, EXPAND_SUM);
+! 	    op0 = memory_address (mode, temp);
+! 	    op0 = copy_all_regs (op0);
+! 	    SAVE_EXPR_RTL (exp1) = op0;
+! 	  }
+! 	else
+! 	  {
+! 	    op0 = expand_expr (exp1, NULL_RTX, VOIDmode, EXPAND_SUM);
+! 	    op0 = memory_address (mode, op0);
+! 	  }
+  
+  	temp = gen_rtx (MEM, mode, op0);
+--- 4664,4669 ----
+  	tree exp2;
+  
+! 	op0 = expand_expr (exp1, NULL_RTX, VOIDmode, EXPAND_SUM);
+! 	op0 = memory_address (mode, op0);
+  
+  	temp = gen_rtx (MEM, mode, op0);
+*************** expand_expr (exp, target, tmode, modifie
+*** 4770,4776 ****
+  	tree offset;
+  	int volatilep = 0;
+- 	tree tem = get_inner_reference (exp, &bitsize, &bitpos, &offset,
+- 					&mode1, &unsignedp, &volatilep);
+  	int alignment;
+  
+  	/* If we got back the original object, something is wrong.  Perhaps
+--- 4872,4879 ----
+  	tree offset;
+  	int volatilep = 0;
+  	int alignment;
++ 	tree tem = get_inner_reference (exp, &bitsize, &bitpos, &offset,
++ 					&mode1, &unsignedp, &volatilep,
++ 					&alignment);
+  
+  	/* If we got back the original object, something is wrong.  Perhaps
+*************** expand_expr (exp, target, tmode, modifie
+*** 4793,4797 ****
+  				!= INTEGER_CST)
+  			    ? target : NULL_RTX),
+! 			   VOIDmode, EXPAND_SUM);
+  
+  	/* If this is a constant, put it into a register if it is a
+--- 4896,4901 ----
+  				!= INTEGER_CST)
+  			    ? target : NULL_RTX),
+! 			   VOIDmode,
+! 			   modifier == EXPAND_INITIALIZER ? modifier : 0);
+  
+  	/* If this is a constant, put it into a register if it is a
+*************** expand_expr (exp, target, tmode, modifie
+*** 4806,4810 ****
+  	  }
+  
+- 	alignment = TYPE_ALIGN (TREE_TYPE (tem)) / BITS_PER_UNIT;
+  	if (offset != 0)
+  	  {
+--- 4910,4913 ----
+*************** expand_expr (exp, target, tmode, modifie
+*** 4816,4827 ****
+  				  gen_rtx (PLUS, ptr_mode, XEXP (op0, 0),
+  					   force_reg (ptr_mode, offset_rtx)));
+- 	  /* If we have a variable offset, the known alignment
+- 	     is only that of the innermost structure containing the field.
+- 	     (Actually, we could sometimes do better by using the
+- 	     size of an element of the innermost array, but no need.)  */
+- 	  if (TREE_CODE (exp) == COMPONENT_REF
+- 	      || TREE_CODE (exp) == BIT_FIELD_REF)
+- 	    alignment = (TYPE_ALIGN (TREE_TYPE (TREE_OPERAND (exp, 0)))
+- 			 / BITS_PER_UNIT);
+  	  }
+  
+--- 4919,4922 ----
+*************** expand_expr (exp, target, tmode, modifie
+*** 4844,4848 ****
+  		&& modifier != EXPAND_SUM
+  		&& modifier != EXPAND_INITIALIZER
+! 		&& ((mode1 != BLKmode && ! direct_load[(int) mode1])
+  		    /* If the field isn't aligned enough to fetch as a memref,
+  		       fetch it as a bit field.  */
+--- 4939,4945 ----
+  		&& modifier != EXPAND_SUM
+  		&& modifier != EXPAND_INITIALIZER
+! 		&& ((mode1 != BLKmode && ! direct_load[(int) mode1]
+! 		     && GET_MODE_CLASS (mode) != MODE_COMPLEX_INT
+! 		     && GET_MODE_CLASS (mode) != MODE_COMPLEX_FLOAT)
+  		    /* If the field isn't aligned enough to fetch as a memref,
+  		       fetch it as a bit field.  */
+*************** expand_expr (exp, target, tmode, modifie
+*** 4857,4861 ****
+  
+  	    if (ext_mode == BLKmode)
+! 	      abort ();
+  
+  	    op0 = extract_bit_field (validize_mem (op0), bitsize, bitpos,
+--- 4954,4982 ----
+  
+  	    if (ext_mode == BLKmode)
+! 	      {
+! 		/* In this case, BITPOS must start at a byte boundary and
+! 		   TARGET, if specified, must be a MEM.  */
+! 		if (GET_CODE (op0) != MEM
+! 		    || (target != 0 && GET_CODE (target) != MEM)
+! 		    || bitpos % BITS_PER_UNIT != 0)
+! 		  abort ();
+! 
+! 		op0 = change_address (op0, VOIDmode,
+! 				      plus_constant (XEXP (op0, 0),
+! 						     bitpos / BITS_PER_UNIT));
+! 		if (target == 0)
+! 		  {
+! 		    target
+! 		      = assign_stack_temp (mode, int_size_in_bytes (type), 0);
+! 		    MEM_IN_STRUCT_P (target) = AGGREGATE_TYPE_P (type);
+! 		  }
+! 
+! 		emit_block_move (target, op0,
+! 				 GEN_INT ((bitsize + BITS_PER_UNIT - 1)
+! 					  / BITS_PER_UNIT),
+! 				 1);
+! 		
+! 		return target;
+! 	      }
+  
+  	    op0 = extract_bit_field (validize_mem (op0), bitsize, bitpos,
+*************** expand_expr (exp, target, tmode, modifie
+*** 4863,4866 ****
+--- 4984,4999 ----
+  				     alignment,
+  				     int_size_in_bytes (TREE_TYPE (tem)));
++ 
++ 	    /* If the result is a record type and BITSIZE is narrower than
++ 	       the mode of OP0, an integral mode, and this is a big endian
++ 	       machine, we must put the field into the high-order bits.  */
++ 	    if (TREE_CODE (type) == RECORD_TYPE && BYTES_BIG_ENDIAN
++ 		&& GET_MODE_CLASS (GET_MODE (op0)) == MODE_INT
++ 		&& bitsize < GET_MODE_BITSIZE (GET_MODE (op0)))
++ 	      op0 = expand_shift (LSHIFT_EXPR, GET_MODE (op0), op0,
++ 				  size_int (GET_MODE_BITSIZE (GET_MODE (op0))
++ 					    - bitsize),
++ 				  op0, 1);
++ 
+  	    if (mode == BLKmode)
+  	      {
+*************** expand_expr (exp, target, tmode, modifie
+*** 4877,4880 ****
+--- 5010,5018 ----
+  	  }
+  
++ 	/* If the result is BLKmode, use that to access the object
++ 	   now as well.  */
++ 	if (mode == BLKmode)
++ 	  mode1 = BLKmode;
++ 
+  	/* Get a reference to just this component.  */
+  	if (modifier == EXPAND_CONST_ADDRESS
+*************** expand_expr (exp, target, tmode, modifie
+*** 4888,4895 ****
+  	MEM_IN_STRUCT_P (op0) = 1;
+  	MEM_VOLATILE_P (op0) |= volatilep;
+! 	if (mode == mode1 || mode1 == BLKmode || mode1 == tmode)
+  	  return op0;
+! 	if (target == 0)
+  	  target = gen_reg_rtx (tmode != VOIDmode ? tmode : mode);
+  	convert_move (target, op0, unsignedp);
+  	return target;
+--- 5026,5036 ----
+  	MEM_IN_STRUCT_P (op0) = 1;
+  	MEM_VOLATILE_P (op0) |= volatilep;
+! 	if (mode == mode1 || mode1 == BLKmode || mode1 == tmode
+! 	    || modifier == EXPAND_CONST_ADDRESS
+! 	    || modifier == EXPAND_INITIALIZER)
+  	  return op0;
+! 	else if (target == 0)
+  	  target = gen_reg_rtx (tmode != VOIDmode ? tmode : mode);
++ 
+  	convert_move (target, op0, unsignedp);
+  	return target;
+*************** expand_builtin (exp, target, subtarget, 
+*** 7986,7989 ****
+--- 8127,8365 ----
+  #endif
+  
++       /* __builtin_setjmp is passed a pointer to an array of five words
++ 	 (not all will be used on all machines).  It operates similarly to
++ 	 the C library function of the same name, but is more efficient.
++ 	 Much of the code below (and for longjmp) is copied from the handling
++ 	 of non-local gotos.
++ 
++ 	 NOTE: This is intended for use by GNAT and will only work in
++ 	 the method used by it.  This code will likely NOT survive to 
++ 	 the GCC 2.8.0 release.  */
++     case BUILT_IN_SETJMP:
++       if (arglist == 0
++ 	  || TREE_CODE (TREE_TYPE (TREE_VALUE (arglist))) != POINTER_TYPE)
++ 	break;
++ 
++       {
++ 	rtx buf_addr = expand_expr (TREE_VALUE (arglist), subtarget,
++ 				    VOIDmode, 0);
++ 	rtx lab1 = gen_label_rtx (), lab2 = gen_label_rtx ();
++ 	enum machine_mode sa_mode = Pmode;
++ 	rtx stack_save;
++ 	int old_inhibit_defer_pop = inhibit_defer_pop;
++ 	int return_pops = RETURN_POPS_ARGS (get_identifier ("__dummy"),
++ 					    get_identifier ("__dummy"), 0);
++ 	rtx next_arg_reg;
++ 	CUMULATIVE_ARGS args_so_far;
++ 	int current_call_is_indirect = 1;
++ 	int i;
++ 
++ #ifdef POINTERS_EXTEND_UNSIGNED
++ 	buf_addr = convert_memory_address (Pmode, buf_addr);
++ #endif
++ 
++ 	buf_addr = force_reg (Pmode, buf_addr);
++ 
++ 	if (target == 0 || GET_CODE (target) != REG
++ 	    || REGNO (target) < FIRST_PSEUDO_REGISTER)
++ 	  target = gen_reg_rtx (value_mode);
++ 
++ 	emit_queue ();
++ 
++ 	CONST_CALL_P (emit_note (NULL_PTR, NOTE_INSN_SETJMP)) = 1;
++ 	current_function_calls_setjmp = 1;
++ 
++ 	/* We store the frame pointer and the address of lab1 in the buffer
++ 	   and use the rest of it for the stack save area, which is
++ 	   machine-dependent.  */
++ 	emit_move_insn (gen_rtx (MEM, Pmode, buf_addr),
++ 			virtual_stack_vars_rtx);
++ 	emit_move_insn
++ 	  (validize_mem (gen_rtx (MEM, Pmode,
++ 				  plus_constant (buf_addr,
++ 						 GET_MODE_SIZE (Pmode)))),
++ 	   gen_rtx (LABEL_REF, Pmode, lab1));
++ 
++ #ifdef HAVE_save_stack_nonlocal
++ 	if (HAVE_save_stack_nonlocal)
++ 	  sa_mode = insn_operand_mode[(int) CODE_FOR_save_stack_nonlocal][0];
++ #endif
++ 
++ 	current_function_has_nonlocal_goto = 1;
++ 
++ 	stack_save = gen_rtx (MEM, sa_mode,
++ 			      plus_constant (buf_addr,
++ 					     2 * GET_MODE_SIZE (Pmode)));
++ 	emit_stack_save (SAVE_NONLOCAL, &stack_save, NULL_RTX);
++ 
++ #ifdef HAVE_setjmp
++ 	if (HAVE_setjmp)
++ 	  emit_insn (gen_setjmp ());
++ #endif
++ 
++ 	/* Set TARGET to zero and branch around the other case.  */
++ 	emit_move_insn (target, const0_rtx);
++ 	emit_jump_insn (gen_jump (lab2));
++ 	emit_barrier ();
++ 	emit_label (lab1);
++ 
++ 	/* Note that setjmp clobbers FP when we get here, so we have to
++ 	   make sure it's marked as used by this function. */
++ 	emit_insn (gen_rtx (USE, VOIDmode, hard_frame_pointer_rtx));
++ 
++ 	/* Mark the static chain as clobbered here so life information
++ 	   doesn't get messed up for it.  */
++ 	emit_insn (gen_rtx (CLOBBER, VOIDmode, static_chain_rtx));
++ 
++ 	/* Now put in the code to restore the frame pointer, and argument
++ 	   pointer, if needed.  The code below is from expand_end_bindings
++ 	   in stmt.c; see detailed documentation there.  */
++ #ifdef HAVE_nonlocal_goto
++ 	if (! HAVE_nonlocal_goto)
++ #endif
++ 	  emit_move_insn (virtual_stack_vars_rtx, hard_frame_pointer_rtx);
++ 
++ #if ARG_POINTER_REGNUM != HARD_FRAME_POINTER_REGNUM
++ 	if (fixed_regs[ARG_POINTER_REGNUM])
++ 	  {
++ #ifdef ELIMINABLE_REGS
++ 	    static struct elims {int from, to;} elim_regs[] = ELIMINABLE_REGS;
++ 
++ 	    for (i = 0; i < sizeof elim_regs / sizeof elim_regs[0]; i++)
++ 	      if (elim_regs[i].from == ARG_POINTER_REGNUM
++ 		  && elim_regs[i].to == HARD_FRAME_POINTER_REGNUM)
++ 		break;
++ 
++ 	    if (i == sizeof elim_regs / sizeof elim_regs [0])
++ #endif
++ 	      {
++ 		/* Now restore our arg pointer from the address at which it
++ 		   was saved in our stack frame.
++ 		   If there hasn't be space allocated for it yet, make
++ 		   some now.  */
++ 		if (arg_pointer_save_area == 0)
++ 		  arg_pointer_save_area
++ 		    = assign_stack_local (Pmode, GET_MODE_SIZE (Pmode), 0);
++ 		emit_move_insn (virtual_incoming_args_rtx,
++ 				copy_to_reg (arg_pointer_save_area));
++ 	      }
++ 	  }
++ #endif
++ 
++ #ifdef HAVE_nonlocal_goto_receiver
++ 	if (HAVE_nonlocal_goto_receiver)
++ 	  emit_insn (gen_nonlocal_goto_receiver ());
++ #endif
++ 	/* The static chain pointer contains the address of dummy function.
++ 	   We need to call it here to handle some PIC cases of restoring
++ 	   a global pointer.  Then return 1.  */
++ 	op0 = copy_to_mode_reg (Pmode, static_chain_rtx);
++ 
++ 	/* We can't actually call emit_library_call here, so do everything
++ 	   it does, which isn't much for a libfunc with no args.  */
++ 	op0 = memory_address (FUNCTION_MODE, op0);
++ 
++ 	INIT_CUMULATIVE_ARGS (args_so_far, NULL_TREE,
++ 			      gen_rtx (SYMBOL_REF, Pmode, "__dummy"));
++ 	next_arg_reg = FUNCTION_ARG (args_so_far, VOIDmode, void_type_node, 1);
++ 
++ #ifndef ACCUMULATE_OUTGOING_ARGS
++ #ifdef HAVE_call_pop
++ 	if (HAVE_call_pop)
++ 	  emit_call_insn (gen_call_pop (gen_rtx (MEM, FUNCTION_MODE, op0),
++ 					const0_rtx, next_arg_reg,
++ 					GEN_INT (return_pops)));
++ 	else
++ #endif
++ #endif
++ 
++ #ifdef HAVE_call
++ 	if (HAVE_call)
++ 	  emit_call_insn (gen_call (gen_rtx (MEM, FUNCTION_MODE, op0),
++ 				    const0_rtx, next_arg_reg, const0_rtx));
++ 	else
++ #endif
++ 	    abort ();
++ 
++ 	emit_move_insn (target, const1_rtx);
++ 	emit_label (lab2);
++ 	return target;
++       }
++ 
++       /* __builtin_longjmp is passed a pointer to an array of five words
++ 	 and a value, which is a dummy.  It's similar to the C library longjmp
++ 	 function but works with __builtin_setjmp above.  */
++     case BUILT_IN_LONGJMP:
++       if (arglist == 0 || TREE_CHAIN (arglist) == 0
++ 	  || TREE_CODE (TREE_TYPE (TREE_VALUE (arglist))) != POINTER_TYPE)
++ 	break;
++ 
++       {
++ 	tree dummy_id = get_identifier ("__dummy");
++ 	tree dummy_type = build_function_type (void_type_node, NULL_TREE);
++ 	tree dummy_decl = build_decl (FUNCTION_DECL, dummy_id, dummy_type); 
++ #ifdef POINTERS_EXTEND_UNSIGNED
++ 	rtx buf_addr
++ 	  = force_reg (Pmode,
++ 		       convert_memory_address
++ 		       (Pmode,
++ 			expand_expr (TREE_VALUE (arglist),
++ 				     NULL_RTX, VOIDmode, 0)));
++ #else
++ 	rtx buf_addr
++ 	  = force_reg (Pmode, expand_expr (TREE_VALUE (arglist),
++ 					   NULL_RTX,
++ 					   VOIDmode, 0));
++ #endif
++ 	rtx fp = gen_rtx (MEM, Pmode, buf_addr);
++ 	rtx lab = gen_rtx (MEM, Pmode,
++ 			   plus_constant (buf_addr, GET_MODE_SIZE (Pmode)));
++ 	enum machine_mode sa_mode
++ #ifdef HAVE_save_stack_nonlocal
++ 	  = (HAVE_save_stack_nonlocal
++ 	     ? insn_operand_mode[(int) CODE_FOR_save_stack_nonlocal][0]
++ 	     : Pmode);
++ #else
++ 	= Pmode;
++ #endif
++ 	rtx stack = gen_rtx (MEM, sa_mode,
++ 			     plus_constant (buf_addr,
++ 					    2 * GET_MODE_SIZE (Pmode)));
++ 
++ 	DECL_EXTERNAL (dummy_decl) = 1;
++ 	TREE_PUBLIC (dummy_decl) = 1;
++ 	make_decl_rtl (dummy_decl, NULL_PTR, 1);
++ 
++ 	/* Expand the second expression just for side-effects.  */
++ 	expand_expr (TREE_VALUE (TREE_CHAIN (arglist)),
++ 		     const0_rtx, VOIDmode, 0);
++ 
++ 	assemble_external (dummy_decl);
++ 
++ 	/* Pick up FP, label, and SP from the block and jump.  This code is
++ 	   from expand_goto in stmt.c; see there for detailed comments.  */
++ #if HAVE_nonlocal_goto
++ 	if (HAVE_nonlocal_goto)
++ 	  emit_insn (gen_nonlocal_goto (fp, lab, stack,
++ 					XEXP (DECL_RTL (dummy_decl), 0)));
++       else
++ #endif
++ 	{
++ 	  lab = copy_to_reg (lab);
++ 	  emit_move_insn (hard_frame_pointer_rtx, fp);
++ 	  emit_stack_restore (SAVE_NONLOCAL, stack, NULL_RTX);
++ 
++ 	  /* Put in the static chain register the address of the dummy
++ 	     function.  */
++ 	  emit_move_insn (static_chain_rtx, XEXP (DECL_RTL (dummy_decl), 0));
++ 	  emit_insn (gen_rtx (USE, VOIDmode, hard_frame_pointer_rtx));
++ 	  emit_insn (gen_rtx (USE, VOIDmode, stack_pointer_rtx));
++ 	  emit_insn (gen_rtx (USE, VOIDmode, static_chain_rtx));
++ 	  emit_indirect_jump (lab);
++ 	}
++ 
++ 	return const0_rtx;
++       }
++ 
+      default:			/* just do library call, if unknown builtin */
+        error ("built-in function `%s' not currently supported",
+*************** preexpand_calls (exp)
+*** 8688,8701 ****
+      case CALL_EXPR:
+        /* Do nothing if already expanded.  */
+!       if (CALL_EXPR_RTL (exp) != 0)
+  	return;
+  
+!       /* Do nothing to built-in functions.  */
+!       if (TREE_CODE (TREE_OPERAND (exp, 0)) != ADDR_EXPR
+! 	  || TREE_CODE (TREE_OPERAND (TREE_OPERAND (exp, 0), 0)) != FUNCTION_DECL
+! 	  || ! DECL_BUILT_IN (TREE_OPERAND (TREE_OPERAND (exp, 0), 0))
+! 	  /* Do nothing if the call returns a variable-sized object.  */
+! 	  || TREE_CODE (TYPE_SIZE (TREE_TYPE(exp))) != INTEGER_CST)
+! 	CALL_EXPR_RTL (exp) = expand_call (exp, NULL_RTX, 0);
+        return;
+  
+--- 9064,9078 ----
+      case CALL_EXPR:
+        /* Do nothing if already expanded.  */
+!       if (CALL_EXPR_RTL (exp) != 0
+! 	  /* Do nothing if the call returns a variable-sized object.  */
+! 	  || TREE_CODE (TYPE_SIZE (TREE_TYPE(exp))) != INTEGER_CST
+! 	  /* Do nothing to built-in functions.  */
+! 	  || (TREE_CODE (TREE_OPERAND (exp, 0)) == ADDR_EXPR
+! 	      && (TREE_CODE (TREE_OPERAND (TREE_OPERAND (exp, 0), 0))
+! 		  == FUNCTION_DECL)
+! 	      && DECL_BUILT_IN (TREE_OPERAND (TREE_OPERAND (exp, 0), 0))))
+  	return;
+  
+!       CALL_EXPR_RTL (exp) = expand_call (exp, NULL_RTX, 0);
+        return;
+  
+*************** do_jump (exp, if_false_label, if_true_la
+*** 9087,9090 ****
+--- 9464,9468 ----
+        push_temp_slots ();
+        expand_expr (TREE_OPERAND (exp, 0), const0_rtx, VOIDmode, 0);
++       preserve_temp_slots (NULL_RTX);
+        free_temp_slots ();
+        pop_temp_slots ();
+*************** do_jump (exp, if_false_label, if_true_la
+*** 9103,9111 ****
+  	tree offset;
+  	int volatilep = 0;
+  
+  	/* Get description of this reference.  We don't actually care
+  	   about the underlying object here.  */
+  	get_inner_reference (exp, &bitsize, &bitpos, &offset,
+! 			     &mode, &unsignedp, &volatilep);
+  
+  	type = type_for_size (bitsize, unsignedp);
+--- 9481,9491 ----
+  	tree offset;
+  	int volatilep = 0;
++ 	int alignment;
+  
+  	/* Get description of this reference.  We don't actually care
+  	   about the underlying object here.  */
+  	get_inner_reference (exp, &bitsize, &bitpos, &offset,
+! 			     &mode, &unsignedp, &volatilep,
+! 			     &alignment);
+  
+  	type = type_for_size (bitsize, unsignedp);
+diff -rcp2N gcc-2.7.2.2/final.c g77-new/final.c
+*** gcc-2.7.2.2/final.c	Sun Nov 26 13:50:00 1995
+--- g77-new/final.c	Thu Jul 10 20:11:16 1997
+*************** profile_function (file)
+*** 983,991 ****
+    text_section ();
+  
+! #ifdef STRUCT_VALUE_INCOMING_REGNUM
+    if (sval)
+      ASM_OUTPUT_REG_PUSH (file, STRUCT_VALUE_INCOMING_REGNUM);
+  #else
+! #ifdef STRUCT_VALUE_REGNUM
+    if (sval)
+      ASM_OUTPUT_REG_PUSH (file, STRUCT_VALUE_REGNUM);
+--- 983,991 ----
+    text_section ();
+  
+! #if defined(STRUCT_VALUE_INCOMING_REGNUM) && defined(ASM_OUTPUT_REG_PUSH)
+    if (sval)
+      ASM_OUTPUT_REG_PUSH (file, STRUCT_VALUE_INCOMING_REGNUM);
+  #else
+! #if defined(STRUCT_VALUE_REGNUM) && defined(ASM_OUTPUT_REG_PUSH)
+    if (sval)
+      ASM_OUTPUT_REG_PUSH (file, STRUCT_VALUE_REGNUM);
+*************** profile_function (file)
+*** 993,1027 ****
+  #endif
+  
+! #if 0
+! #ifdef STATIC_CHAIN_INCOMING_REGNUM
+    if (cxt)
+      ASM_OUTPUT_REG_PUSH (file, STATIC_CHAIN_INCOMING_REGNUM);
+  #else
+! #ifdef STATIC_CHAIN_REGNUM
+    if (cxt)
+      ASM_OUTPUT_REG_PUSH (file, STATIC_CHAIN_REGNUM);
+  #endif
+  #endif
+- #endif				/* 0 */
+  
+    FUNCTION_PROFILER (file, profile_label_no);
+  
+! #if 0
+! #ifdef STATIC_CHAIN_INCOMING_REGNUM
+    if (cxt)
+      ASM_OUTPUT_REG_POP (file, STATIC_CHAIN_INCOMING_REGNUM);
+  #else
+! #ifdef STATIC_CHAIN_REGNUM
+    if (cxt)
+      ASM_OUTPUT_REG_POP (file, STATIC_CHAIN_REGNUM);
+  #endif
+  #endif
+- #endif				/* 0 */
+  
+! #ifdef STRUCT_VALUE_INCOMING_REGNUM
+    if (sval)
+      ASM_OUTPUT_REG_POP (file, STRUCT_VALUE_INCOMING_REGNUM);
+  #else
+! #ifdef STRUCT_VALUE_REGNUM
+    if (sval)
+      ASM_OUTPUT_REG_POP (file, STRUCT_VALUE_REGNUM);
+--- 993,1023 ----
+  #endif
+  
+! #if defined(STATIC_CHAIN_INCOMING_REGNUM) && defined(ASM_OUTPUT_REG_PUSH)
+    if (cxt)
+      ASM_OUTPUT_REG_PUSH (file, STATIC_CHAIN_INCOMING_REGNUM);
+  #else
+! #if defined(STATIC_CHAIN_REGNUM) && defined(ASM_OUTPUT_REG_PUSH)
+    if (cxt)
+      ASM_OUTPUT_REG_PUSH (file, STATIC_CHAIN_REGNUM);
+  #endif
+  #endif
+  
+    FUNCTION_PROFILER (file, profile_label_no);
+  
+! #if defined(STATIC_CHAIN_INCOMING_REGNUM) && defined(ASM_OUTPUT_REG_PUSH)
+    if (cxt)
+      ASM_OUTPUT_REG_POP (file, STATIC_CHAIN_INCOMING_REGNUM);
+  #else
+! #if defined(STATIC_CHAIN_REGNUM) && defined(ASM_OUTPUT_REG_PUSH)
+    if (cxt)
+      ASM_OUTPUT_REG_POP (file, STATIC_CHAIN_REGNUM);
+  #endif
+  #endif
+  
+! #if defined(STRUCT_VALUE_INCOMING_REGNUM) && defined(ASM_OUTPUT_REG_PUSH)
+    if (sval)
+      ASM_OUTPUT_REG_POP (file, STRUCT_VALUE_INCOMING_REGNUM);
+  #else
+! #if defined(STRUCT_VALUE_REGNUM) && defined(ASM_OUTPUT_REG_PUSH)
+    if (sval)
+      ASM_OUTPUT_REG_POP (file, STRUCT_VALUE_REGNUM);
+diff -rcp2N gcc-2.7.2.2/flags.h g77-new/flags.h
+*** gcc-2.7.2.2/flags.h	Thu Jun 15 07:34:11 1995
+--- g77-new/flags.h	Thu Jul 10 20:08:56 1997
+*************** extern int flag_unroll_loops;
+*** 204,207 ****
+--- 204,221 ----
+  extern int flag_unroll_all_loops;
+  
++ /* Nonzero forces all invariant computations in loops to be moved
++    outside the loop. */
++ 
++ extern int flag_move_all_movables;
++ 
++ /* Nonzero forces all general induction variables in loops to be
++    strength reduced. */
++ 
++ extern int flag_reduce_all_givs;
++ 
++ /* Nonzero gets another run of loop_optimize performed. */
++ 
++ extern int flag_rerun_loop_opt;
++ 
+  /* Nonzero for -fcse-follow-jumps:
+     have cse follow jumps to do a more extensive job.  */
+*************** extern int flag_gnu_linker;
+*** 339,342 ****
+--- 353,369 ----
+  /* Tag all structures with __attribute__(packed) */
+  extern int flag_pack_struct;
++ 
++ /* 1 if alias checking is enabled: symbols do not alias each other
++    and parameters do not alias the current stack frame.  */
++ extern int flag_alias_check;
++ 
++ /* This flag is only tested if alias checking is enabled.
++    0 if pointer arguments may alias each other.  True in C.
++    1 if pointer arguments may not alias each other but may alias
++    global variables.
++    2 if pointer arguments may not alias each other and may not
++    alias global variables.  True in Fortran.
++    The value is ignored if flag_alias_check is 0.  */
++ extern int flag_argument_noalias;
+  
+  /* Other basic status info about current function.  */
+diff -rcp2N gcc-2.7.2.2/flow.c g77-new/flow.c
+*** gcc-2.7.2.2/flow.c	Mon Aug 28 06:23:34 1995
+--- g77-new/flow.c	Sun Aug 10 18:46:11 1997
+*************** static HARD_REG_SET elim_reg_set;
+*** 288,292 ****
+  /* Forward declarations */
+  static void find_basic_blocks		PROTO((rtx, rtx));
+! static int uses_reg_or_mem		PROTO((rtx));
+  static void mark_label_ref		PROTO((rtx, rtx, int));
+  static void life_analysis		PROTO((rtx, int));
+--- 288,292 ----
+  /* Forward declarations */
+  static void find_basic_blocks		PROTO((rtx, rtx));
+! static int jmp_uses_reg_or_mem		PROTO((rtx));
+  static void mark_label_ref		PROTO((rtx, rtx, int));
+  static void life_analysis		PROTO((rtx, int));
+*************** find_basic_blocks (f, nonlocal_label_lis
+*** 554,563 ****
+  		    if (GET_CODE (XVECEXP (pat, 0, i)) == SET
+  			&& SET_DEST (XVECEXP (pat, 0, i)) == pc_rtx
+! 			&& uses_reg_or_mem (SET_SRC (XVECEXP (pat, 0, i))))
+  		      computed_jump = 1;
+  	      }
+  	    else if (GET_CODE (pat) == SET
+  		     && SET_DEST (pat) == pc_rtx
+! 		     && uses_reg_or_mem (SET_SRC (pat)))
+  	      computed_jump = 1;
+  		    
+--- 554,563 ----
+  		    if (GET_CODE (XVECEXP (pat, 0, i)) == SET
+  			&& SET_DEST (XVECEXP (pat, 0, i)) == pc_rtx
+! 			&& jmp_uses_reg_or_mem (SET_SRC (XVECEXP (pat, 0, i))))
+  		      computed_jump = 1;
+  	      }
+  	    else if (GET_CODE (pat) == SET
+  		     && SET_DEST (pat) == pc_rtx
+! 		     && jmp_uses_reg_or_mem (SET_SRC (pat)))
+  	      computed_jump = 1;
+  		    
+*************** find_basic_blocks (f, nonlocal_label_lis
+*** 760,767 ****
+  /* Subroutines of find_basic_blocks.  */
+  
+! /* Return 1 if X contain a REG or MEM that is not in the constant pool.  */
+  
+  static int
+! uses_reg_or_mem (x)
+       rtx x;
+  {
+--- 760,768 ----
+  /* Subroutines of find_basic_blocks.  */
+  
+! /* Return 1 if X, the SRC_SRC of  SET of (pc) contain a REG or MEM that is
+!    not in the constant pool and not in the condition of an IF_THEN_ELSE.  */
+  
+  static int
+! jmp_uses_reg_or_mem (x)
+       rtx x;
+  {
+*************** uses_reg_or_mem (x)
+*** 770,778 ****
+    char *fmt;
+  
+!   if (code == REG
+!       || (code == MEM
+! 	  && ! (GET_CODE (XEXP (x, 0)) == SYMBOL_REF
+! 		&& CONSTANT_POOL_ADDRESS_P (XEXP (x, 0)))))
+!     return 1;
+  
+    fmt = GET_RTX_FORMAT (code);
+--- 771,796 ----
+    char *fmt;
+  
+!   switch (code)
+!     {
+!     case CONST:
+!     case LABEL_REF:
+!     case PC:
+!       return 0;
+! 
+!     case REG:
+!       return 1;
+! 
+!     case MEM:
+!       return ! (GET_CODE (XEXP (x, 0)) == SYMBOL_REF
+! 		&& CONSTANT_POOL_ADDRESS_P (XEXP (x, 0)));
+! 
+!     case IF_THEN_ELSE:
+!       return (jmp_uses_reg_or_mem (XEXP (x, 1))
+! 	      || jmp_uses_reg_or_mem (XEXP (x, 2)));
+! 
+!     case PLUS:  case MINUS:  case MULT:
+!       return (jmp_uses_reg_or_mem (XEXP (x, 0))
+! 	      || jmp_uses_reg_or_mem (XEXP (x, 1)));
+!     }
+  
+    fmt = GET_RTX_FORMAT (code);
+*************** uses_reg_or_mem (x)
+*** 780,789 ****
+      {
+        if (fmt[i] == 'e'
+! 	  && uses_reg_or_mem (XEXP (x, i)))
+  	return 1;
+  
+        if (fmt[i] == 'E')
+  	for (j = 0; j < XVECLEN (x, i); j++)
+! 	  if (uses_reg_or_mem (XVECEXP (x, i, j)))
+  	    return 1;
+      }
+--- 798,807 ----
+      {
+        if (fmt[i] == 'e'
+! 	  && jmp_uses_reg_or_mem (XEXP (x, i)))
+  	return 1;
+  
+        if (fmt[i] == 'E')
+  	for (j = 0; j < XVECLEN (x, i); j++)
+! 	  if (jmp_uses_reg_or_mem (XVECEXP (x, i, j)))
+  	    return 1;
+      }
+*************** propagate_block (old, first, last, final
+*** 1605,1614 ****
+  
+  		  /* Each call clobbers all call-clobbered regs that are not
+! 		     global.  Note that the function-value reg is a
+  		     call-clobbered reg, and mark_set_regs has already had
+  		     a chance to handle it.  */
+  
+  		  for (i = 0; i < FIRST_PSEUDO_REGISTER; i++)
+! 		    if (call_used_regs[i] && ! global_regs[i])
+  		      dead[i / REGSET_ELT_BITS]
+  			|= ((REGSET_ELT_TYPE) 1 << (i % REGSET_ELT_BITS));
+--- 1623,1633 ----
+  
+  		  /* Each call clobbers all call-clobbered regs that are not
+! 		     global or fixed.  Note that the function-value reg is a
+  		     call-clobbered reg, and mark_set_regs has already had
+  		     a chance to handle it.  */
+  
+  		  for (i = 0; i < FIRST_PSEUDO_REGISTER; i++)
+! 		    if (call_used_regs[i] && ! global_regs[i]
+! 			&& ! fixed_regs[i])
+  		      dead[i / REGSET_ELT_BITS]
+  			|= ((REGSET_ELT_TYPE) 1 << (i % REGSET_ELT_BITS));
+diff -rcp2N gcc-2.7.2.2/fold-const.c g77-new/fold-const.c
+*** gcc-2.7.2.2/fold-const.c	Fri Sep 15 18:26:12 1995
+--- g77-new/fold-const.c	Sun Aug 10 18:47:18 1997
+*************** static tree unextend	PROTO((tree, int, i
+*** 80,83 ****
+--- 80,84 ----
+  static tree fold_truthop PROTO((enum tree_code, tree, tree, tree));
+  static tree strip_compound_expr PROTO((tree, tree));
++ static int multiple_of_p PROTO((tree, tree, tree));
+  
+  #ifndef BRANCH_COST
+*************** const_binop (code, arg1, arg2, notrunc)
+*** 1077,1080 ****
+--- 1078,1083 ----
+  	  if (int2h == 0 && int2l > 0
+  	      && TREE_TYPE (arg1) == sizetype
++ 	      && ! TREE_CONSTANT_OVERFLOW (arg1)
++ 	      && ! TREE_CONSTANT_OVERFLOW (arg2)
+  	      && int1h == 0 && int1l >= 0)
+  	    {
+*************** const_binop (code, arg1, arg2, notrunc)
+*** 1230,1233 ****
+--- 1233,1237 ----
+    if (TREE_CODE (arg1) == COMPLEX_CST)
+      {
++       register tree type = TREE_TYPE (arg1);
+        register tree r1 = TREE_REALPART (arg1);
+        register tree i1 = TREE_IMAGPART (arg1);
+*************** const_binop (code, arg1, arg2, notrunc)
+*** 1239,1253 ****
+  	{
+  	case PLUS_EXPR:
+! 	  t = build_complex (const_binop (PLUS_EXPR, r1, r2, notrunc),
+  			     const_binop (PLUS_EXPR, i1, i2, notrunc));
+  	  break;
+  
+  	case MINUS_EXPR:
+! 	  t = build_complex (const_binop (MINUS_EXPR, r1, r2, notrunc),
+  			     const_binop (MINUS_EXPR, i1, i2, notrunc));
+  	  break;
+  
+  	case MULT_EXPR:
+! 	  t = build_complex (const_binop (MINUS_EXPR,
+  					  const_binop (MULT_EXPR,
+  						       r1, r2, notrunc),
+--- 1243,1260 ----
+  	{
+  	case PLUS_EXPR:
+! 	  t = build_complex (type,
+! 			     const_binop (PLUS_EXPR, r1, r2, notrunc),
+  			     const_binop (PLUS_EXPR, i1, i2, notrunc));
+  	  break;
+  
+  	case MINUS_EXPR:
+! 	  t = build_complex (type,
+! 			     const_binop (MINUS_EXPR, r1, r2, notrunc),
+  			     const_binop (MINUS_EXPR, i1, i2, notrunc));
+  	  break;
+  
+  	case MULT_EXPR:
+! 	  t = build_complex (type,
+! 			     const_binop (MINUS_EXPR,
+  					  const_binop (MULT_EXPR,
+  						       r1, r2, notrunc),
+*************** const_binop (code, arg1, arg2, notrunc)
+*** 1271,1293 ****
+  			     notrunc);
+  
+! 	    t = build_complex
+! 	      (const_binop (INTEGRAL_TYPE_P (TREE_TYPE (r1))
+! 			    ? TRUNC_DIV_EXPR : RDIV_EXPR,
+! 			    const_binop (PLUS_EXPR,
+! 					 const_binop (MULT_EXPR, r1, r2,
+! 						      notrunc),
+! 					 const_binop (MULT_EXPR, i1, i2,
+! 						      notrunc),
+! 					 notrunc),
+! 			    magsquared, notrunc),
+! 	       const_binop (INTEGRAL_TYPE_P (TREE_TYPE (r1))
+! 			    ? TRUNC_DIV_EXPR : RDIV_EXPR,
+! 			    const_binop (MINUS_EXPR,
+! 					 const_binop (MULT_EXPR, i1, r2,
+! 						      notrunc),
+! 					 const_binop (MULT_EXPR, r1, i2,
+! 						      notrunc),
+! 					 notrunc),
+! 			    magsquared, notrunc));
+  	  }
+  	  break;
+--- 1278,1302 ----
+  			     notrunc);
+  
+! 	    t = build_complex (type,
+! 			       const_binop
+! 			       (INTEGRAL_TYPE_P (TREE_TYPE (r1))
+! 				? TRUNC_DIV_EXPR : RDIV_EXPR,
+! 				const_binop (PLUS_EXPR,
+! 					     const_binop (MULT_EXPR, r1, r2,
+! 							  notrunc),
+! 					     const_binop (MULT_EXPR, i1, i2,
+! 							  notrunc),
+! 					     notrunc),
+! 				magsquared, notrunc),
+! 			       const_binop
+! 			       (INTEGRAL_TYPE_P (TREE_TYPE (r1))
+! 				? TRUNC_DIV_EXPR : RDIV_EXPR,
+! 				const_binop (MINUS_EXPR,
+! 					     const_binop (MULT_EXPR, i1, r2,
+! 							  notrunc),
+! 					     const_binop (MULT_EXPR, r1, i2,
+! 							  notrunc),
+! 					     notrunc),
+! 				magsquared, notrunc));
+  	  }
+  	  break;
+*************** const_binop (code, arg1, arg2, notrunc)
+*** 1296,1300 ****
+  	  abort ();
+  	}
+-       TREE_TYPE (t) = TREE_TYPE (arg1);
+        return t;
+      }
+--- 1305,1308 ----
+*************** size_binop (code, arg0, arg1)
+*** 1346,1363 ****
+      {
+        /* And some specific cases even faster than that.  */
+!       if (code == PLUS_EXPR
+! 	  && TREE_INT_CST_LOW (arg0) == 0
+! 	  && TREE_INT_CST_HIGH (arg0) == 0)
+  	return arg1;
+!       if (code == MINUS_EXPR
+! 	  && TREE_INT_CST_LOW (arg1) == 0
+! 	  && TREE_INT_CST_HIGH (arg1) == 0)
+  	return arg0;
+!       if (code == MULT_EXPR
+! 	  && TREE_INT_CST_LOW (arg0) == 1
+! 	  && TREE_INT_CST_HIGH (arg0) == 0)
+  	return arg1;
+        /* Handle general case of two integer constants.  */
+!       return const_binop (code, arg0, arg1, 0);
+      }
+  
+--- 1354,1367 ----
+      {
+        /* And some specific cases even faster than that.  */
+!       if (code == PLUS_EXPR && integer_zerop (arg0))
+  	return arg1;
+!       else if ((code == MINUS_EXPR || code == PLUS_EXPR)
+! 	       && integer_zerop (arg1))
+  	return arg0;
+!       else if (code == MULT_EXPR && integer_onep (arg0))
+  	return arg1;
++ 
+        /* Handle general case of two integer constants.  */
+!       return const_binop (code, arg0, arg1, 1);
+      }
+  
+*************** fold_convert (t, arg1)
+*** 1482,1486 ****
+  	{
+  	  if (REAL_VALUE_ISNAN (TREE_REAL_CST (arg1)))
+! 	    return arg1;
+  	  else if (setjmp (float_error))
+  	    {
+--- 1486,1494 ----
+  	{
+  	  if (REAL_VALUE_ISNAN (TREE_REAL_CST (arg1)))
+! 	    {
+! 	      t = arg1;
+! 	      TREE_TYPE (arg1) = type;
+! 	      return t;
+! 	    }
+  	  else if (setjmp (float_error))
+  	    {
+*************** operand_equal_p (arg0, arg1, only_const)
+*** 1644,1687 ****
+    STRIP_NOPS (arg1);
+  
+!   /* If ARG0 and ARG1 are the same SAVE_EXPR, they are necessarily equal.
+!      We don't care about side effects in that case because the SAVE_EXPR
+!      takes care of that for us.  */
+!   if (TREE_CODE (arg0) == SAVE_EXPR && arg0 == arg1)
+!     return ! only_const;
+! 
+!   if (TREE_SIDE_EFFECTS (arg0) || TREE_SIDE_EFFECTS (arg1))
+      return 0;
+  
+!   if (TREE_CODE (arg0) == TREE_CODE (arg1)
+!       && TREE_CODE (arg0) == ADDR_EXPR
+!       && TREE_OPERAND (arg0, 0) == TREE_OPERAND (arg1, 0))
+!     return 1;
+! 
+!   if (TREE_CODE (arg0) == TREE_CODE (arg1)
+!       && TREE_CODE (arg0) == INTEGER_CST
+!       && TREE_INT_CST_LOW (arg0) == TREE_INT_CST_LOW (arg1)
+!       && TREE_INT_CST_HIGH (arg0) == TREE_INT_CST_HIGH (arg1))
+      return 1;
+  
+!   /* Detect when real constants are equal.  */
+!   if (TREE_CODE (arg0) == TREE_CODE (arg1)
+!       && TREE_CODE (arg0) == REAL_CST)
+!     return !bcmp ((char *) &TREE_REAL_CST (arg0),
+! 		  (char *) &TREE_REAL_CST (arg1),
+! 		  sizeof (REAL_VALUE_TYPE));
+  
+    if (only_const)
+      return 0;
+  
+-   if (arg0 == arg1)
+-     return 1;
+- 
+-   if (TREE_CODE (arg0) != TREE_CODE (arg1))
+-     return 0;
+-   /* This is needed for conversions and for COMPONENT_REF.
+-      Might as well play it safe and always test this.  */
+-   if (TYPE_MODE (TREE_TYPE (arg0)) != TYPE_MODE (TREE_TYPE (arg1)))
+-     return 0;
+- 
+    switch (TREE_CODE_CLASS (TREE_CODE (arg0)))
+      {
+--- 1652,1705 ----
+    STRIP_NOPS (arg1);
+  
+!   if (TREE_CODE (arg0) != TREE_CODE (arg1)
+!       /* This is needed for conversions and for COMPONENT_REF.
+! 	 Might as well play it safe and always test this.  */
+!       || TYPE_MODE (TREE_TYPE (arg0)) != TYPE_MODE (TREE_TYPE (arg1)))
+      return 0;
+  
+!   /* If ARG0 and ARG1 are the same SAVE_EXPR, they are necessarily equal.
+!      We don't care about side effects in that case because the SAVE_EXPR
+!      takes care of that for us. In all other cases, two expressions are
+!      equal if they have no side effects.  If we have two identical
+!      expressions with side effects that should be treated the same due
+!      to the only side effects being identical SAVE_EXPR's, that will
+!      be detected in the recursive calls below.  */
+!   if (arg0 == arg1 && ! only_const
+!       && (TREE_CODE (arg0) == SAVE_EXPR
+! 	  || (! TREE_SIDE_EFFECTS (arg0) && ! TREE_SIDE_EFFECTS (arg1))))
+      return 1;
+  
+!   /* Next handle constant cases, those for which we can return 1 even
+!      if ONLY_CONST is set.  */
+!   if (TREE_CONSTANT (arg0) && TREE_CONSTANT (arg1))
+!     switch (TREE_CODE (arg0))
+!       {
+!       case INTEGER_CST:
+! 	return (TREE_INT_CST_LOW (arg0) == TREE_INT_CST_LOW (arg1)
+! 		&& TREE_INT_CST_HIGH (arg0) == TREE_INT_CST_HIGH (arg1));
+! 
+!       case REAL_CST:
+! 	return REAL_VALUES_EQUAL (TREE_REAL_CST (arg0), TREE_REAL_CST (arg1));
+! 
+!       case COMPLEX_CST:
+! 	return (operand_equal_p (TREE_REALPART (arg0), TREE_REALPART (arg1),
+! 				 only_const)
+! 		&& operand_equal_p (TREE_IMAGPART (arg0), TREE_IMAGPART (arg1),
+! 				    only_const));
+! 
+!       case STRING_CST:
+! 	return (TREE_STRING_LENGTH (arg0) == TREE_STRING_LENGTH (arg1)
+! 		&& ! strncmp (TREE_STRING_POINTER (arg0),
+! 			      TREE_STRING_POINTER (arg1),
+! 			      TREE_STRING_LENGTH (arg0)));
+! 
+!       case ADDR_EXPR:
+! 	return operand_equal_p (TREE_OPERAND (arg0, 0), TREE_OPERAND (arg1, 0),
+! 				0);
+!       }
+  
+    if (only_const)
+      return 0;
+  
+    switch (TREE_CODE_CLASS (TREE_CODE (arg0)))
+      {
+*************** operand_equal_p (arg0, arg1, only_const)
+*** 1698,1705 ****
+      case '<':
+      case '2':
+!       return (operand_equal_p (TREE_OPERAND (arg0, 0),
+! 			       TREE_OPERAND (arg1, 0), 0)
+  	      && operand_equal_p (TREE_OPERAND (arg0, 1),
+! 				  TREE_OPERAND (arg1, 1), 0));
+  
+      case 'r':
+--- 1716,1735 ----
+      case '<':
+      case '2':
+!       if (operand_equal_p (TREE_OPERAND (arg0, 0), TREE_OPERAND (arg1, 0), 0)
+! 	  && operand_equal_p (TREE_OPERAND (arg0, 1), TREE_OPERAND (arg1, 1),
+! 			      0))
+! 	return 1;
+! 
+!       /* For commutative ops, allow the other order.  */
+!       return ((TREE_CODE (arg0) == PLUS_EXPR || TREE_CODE (arg0) == MULT_EXPR
+! 	       || TREE_CODE (arg0) == MIN_EXPR || TREE_CODE (arg0) == MAX_EXPR
+! 	       || TREE_CODE (arg0) == BIT_IOR_EXPR
+! 	       || TREE_CODE (arg0) == BIT_XOR_EXPR
+! 	       || TREE_CODE (arg0) == BIT_AND_EXPR
+! 	       || TREE_CODE (arg0) == NE_EXPR || TREE_CODE (arg0) == EQ_EXPR)
+! 	      && operand_equal_p (TREE_OPERAND (arg0, 0),
+! 				  TREE_OPERAND (arg1, 1), 0)
+  	      && operand_equal_p (TREE_OPERAND (arg0, 1),
+! 				  TREE_OPERAND (arg1, 0), 0));
+  
+      case 'r':
+*************** optimize_bit_field_compare (code, compar
+*** 2212,2215 ****
+--- 2242,2246 ----
+    int lunsignedp, runsignedp;
+    int lvolatilep = 0, rvolatilep = 0;
++   int alignment;
+    tree linner, rinner;
+    tree mask;
+*************** optimize_bit_field_compare (code, compar
+*** 2220,2224 ****
+       extraction at all and so can do nothing.  */
+    linner = get_inner_reference (lhs, &lbitsize, &lbitpos, &offset, &lmode,
+! 				&lunsignedp, &lvolatilep);
+    if (linner == lhs || lbitsize == GET_MODE_BITSIZE (lmode) || lbitsize < 0
+        || offset != 0)
+--- 2251,2255 ----
+       extraction at all and so can do nothing.  */
+    linner = get_inner_reference (lhs, &lbitsize, &lbitpos, &offset, &lmode,
+! 				&lunsignedp, &lvolatilep, &alignment);
+    if (linner == lhs || lbitsize == GET_MODE_BITSIZE (lmode) || lbitsize < 0
+        || offset != 0)
+*************** optimize_bit_field_compare (code, compar
+*** 2229,2234 ****
+       /* If this is not a constant, we can only do something if bit positions,
+  	sizes, and signedness are the same.   */
+!      rinner = get_inner_reference (rhs, &rbitsize, &rbitpos, &offset,
+! 				   &rmode, &runsignedp, &rvolatilep);
+  
+       if (rinner == rhs || lbitpos != rbitpos || lbitsize != rbitsize
+--- 2260,2265 ----
+       /* If this is not a constant, we can only do something if bit positions,
+  	sizes, and signedness are the same.   */
+!      rinner = get_inner_reference (rhs, &rbitsize, &rbitpos, &offset, &rmode,
+! 				   &runsignedp, &rvolatilep, &alignment);
+  
+       if (rinner == rhs || lbitpos != rbitpos || lbitsize != rbitsize
+*************** decode_field_reference (exp, pbitsize, p
+*** 2403,2406 ****
+--- 2434,2438 ----
+    tree unsigned_type;
+    int precision;
++   int alignment;
+  
+    /* All the optimizations using this function assume integer fields.  
+*************** decode_field_reference (exp, pbitsize, p
+*** 2423,2427 ****
+  
+    inner = get_inner_reference (exp, pbitsize, pbitpos, &offset, pmode,
+! 			       punsignedp, pvolatilep);
+    if ((inner == exp && and_mask == 0)
+        || *pbitsize < 0 || offset != 0)
+--- 2455,2459 ----
+  
+    inner = get_inner_reference (exp, pbitsize, pbitpos, &offset, pmode,
+! 			       punsignedp, pvolatilep, &alignment);
+    if ((inner == exp && and_mask == 0)
+        || *pbitsize < 0 || offset != 0)
+*************** strip_compound_expr (t, s)
+*** 3065,3068 ****
+--- 3097,3200 ----
+  }
+  
++ /* Determine if first argument is a multiple of second argument.
++    Return 0 if it is not, or is not easily determined to so be.
++ 
++    An example of the sort of thing we care about (at this point --
++    this routine could surely be made more general, and expanded
++    to do what the *_DIV_EXPR's fold() cases do now) is discovering
++    that
++ 
++      SAVE_EXPR (I) * SAVE_EXPR (J * 8)
++ 
++    is a multiple of
++ 
++      SAVE_EXPR (J * 8)
++ 
++    when we know that the two `SAVE_EXPR (J * 8)' nodes are the
++    same node (which means they will have the same value at run
++    time, even though we don't know when they'll be assigned).
++ 
++    This code also handles discovering that
++ 
++      SAVE_EXPR (I) * SAVE_EXPR (J * 8)
++ 
++    is a multiple of
++ 
++      8
++ 
++    (of course) so we don't have to worry about dealing with a
++    possible remainder.
++ 
++    Note that we _look_ inside a SAVE_EXPR only to determine
++    how it was calculated; it is not safe for fold() to do much
++    of anything else with the internals of a SAVE_EXPR, since
++    fold() cannot know when it will be evaluated at run time.
++    For example, the latter example above _cannot_ be implemented
++    as
++ 
++      SAVE_EXPR (I) * J
++ 
++    or any variant thereof, since the value of J at evaluation time
++    of the original SAVE_EXPR is not necessarily the same at the time
++    the new expression is evaluated.  The only optimization of this
++    sort that would be valid is changing
++ 
++      SAVE_EXPR (I) * SAVE_EXPR (SAVE_EXPR (J) * 8)
++    divided by
++      8
++ 
++    to
++ 
++      SAVE_EXPR (I) * SAVE_EXPR (J)
++ 
++    (where the same SAVE_EXPR (J) is used in the original and the
++    transformed version).  */
++ 
++ static int
++ multiple_of_p (type, top, bottom)
++      tree type;
++      tree top;
++      tree bottom;
++ {
++   if (operand_equal_p (top, bottom, 0))
++     return 1;
++ 
++   if (TREE_CODE (type) != INTEGER_TYPE)
++     return 0;
++ 
++   switch (TREE_CODE (top))
++     {
++     case MULT_EXPR:
++       return (multiple_of_p (type, TREE_OPERAND (top, 0), bottom)
++ 	      || multiple_of_p (type, TREE_OPERAND (top, 1), bottom));
++ 
++     case PLUS_EXPR:
++     case MINUS_EXPR:
++       return (multiple_of_p (type, TREE_OPERAND (top, 0), bottom)
++ 	      && multiple_of_p (type, TREE_OPERAND (top, 1), bottom));
++ 
++     case NOP_EXPR:
++       /* Punt if conversion from non-integral or wider integral type.  */
++       if ((TREE_CODE (TREE_TYPE (TREE_OPERAND (top, 0))) != INTEGER_TYPE)
++ 	  || (TYPE_PRECISION (type)
++ 	      < TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (top, 0)))))
++ 	return 0;
++       /* Fall through. */
++     case SAVE_EXPR:
++       return multiple_of_p (type, TREE_OPERAND (top, 0), bottom);
++ 
++     case INTEGER_CST:
++       if ((TREE_CODE (bottom) != INTEGER_CST)
++ 	  || (tree_int_cst_sgn (top) < 0)
++ 	  || (tree_int_cst_sgn (bottom) < 0))
++ 	return 0;
++       return integer_zerop (const_binop (TRUNC_MOD_EXPR,
++ 					 top, bottom, 0));
++ 
++     default:
++       return 0;
++     }
++ }
++ 
+  /* Perform constant folding and related simplification of EXPR.
+     The related simplifications include x*1 => x, x*0 => 0, etc.,
+*************** fold (expr) 
+*** 3611,3615 ****
+  				    TREE_OPERAND (arg0, 1))));
+        else if (TREE_CODE (arg0) == COMPLEX_CST)
+! 	return build_complex (TREE_OPERAND (arg0, 0),
+  			      fold (build1 (NEGATE_EXPR,
+  					    TREE_TYPE (TREE_TYPE (arg0)),
+--- 3743,3747 ----
+  				    TREE_OPERAND (arg0, 1))));
+        else if (TREE_CODE (arg0) == COMPLEX_CST)
+! 	return build_complex (type, TREE_OPERAND (arg0, 0),
+  			      fold (build1 (NEGATE_EXPR,
+  					    TREE_TYPE (TREE_TYPE (arg0)),
+*************** fold (expr) 
+*** 4014,4018 ****
+  	return non_lvalue (convert (type, arg0));
+        if (integer_zerop (arg1))
+! 	return t;
+  
+        /* If we have ((a / C1) / C2) where both division are the same type, try
+--- 4146,4166 ----
+  	return non_lvalue (convert (type, arg0));
+        if (integer_zerop (arg1))
+! 	{
+! 	  if (extra_warnings)
+! 	    warning ("integer division by zero");
+! 	  return t;
+! 	}
+! 
+!       /* If arg0 is a multiple of arg1, then rewrite to the fastest div
+! 	 operation, EXACT_DIV_EXPR.  Otherwise, handle folding of
+! 	 general divide.  Note that only CEIL_DIV_EXPR is rewritten now,
+! 	 only because the others seem to be faster in some cases, e.g. the
+! 	 nonoptimized TRUNC_DIV_EXPR or FLOOR_DIV_EXPR on DEC Alpha.  This
+! 	 is probably just due to more work being done on it in expmed.c than
+! 	 on EXACT_DIV_EXPR, and could presumably be fixed, since
+! 	 EXACT_DIV_EXPR should _never_ be slower than *_DIV_EXPR.  */
+!       if ((code == CEIL_DIV_EXPR)
+! 	  && multiple_of_p (type, arg0, arg1))
+! 	return fold (build (EXACT_DIV_EXPR, type, arg0, arg1));
+  
+        /* If we have ((a / C1) / C2) where both division are the same type, try
+*************** fold (expr) 
+*** 4049,4053 ****
+  	  tree xarg0 = arg0;
+  
+! 	  if (TREE_CODE (xarg0) == SAVE_EXPR)
+  	    have_save_expr = 1, xarg0 = TREE_OPERAND (xarg0, 0);
+  
+--- 4197,4201 ----
+  	  tree xarg0 = arg0;
+  
+! 	  if (TREE_CODE (xarg0) == SAVE_EXPR && SAVE_EXPR_RTL (xarg0) == 0)
+  	    have_save_expr = 1, xarg0 = TREE_OPERAND (xarg0, 0);
+  
+*************** fold (expr) 
+*** 4067,4071 ****
+  	    }
+  
+! 	  if (TREE_CODE (xarg0) == SAVE_EXPR)
+  	    have_save_expr = 1, xarg0 = TREE_OPERAND (xarg0, 0);
+  
+--- 4215,4219 ----
+  	    }
+  
+! 	  if (TREE_CODE (xarg0) == SAVE_EXPR && SAVE_EXPR_RTL (xarg0) == 0)
+  	    have_save_expr = 1, xarg0 = TREE_OPERAND (xarg0, 0);
+  
+*************** fold (expr) 
+*** 5050,5054 ****
+      case COMPLEX_EXPR:
+        if (wins)
+! 	return build_complex (arg0, arg1);
+        return t;
+  
+--- 5198,5202 ----
+      case COMPLEX_EXPR:
+        if (wins)
+! 	return build_complex (type, arg0, arg1);
+        return t;
+  
+diff -rcp2N gcc-2.7.2.2/function.c g77-new/function.c
+*** gcc-2.7.2.2/function.c	Sun Nov 26 14:50:26 1995
+--- g77-new/function.c	Sun Aug 10 18:47:24 1997
+*************** free_temps_for_rtl_expr (t)
+*** 1184,1187 ****
+--- 1184,1202 ----
+  }
+  
++ /* Mark all temporaries ever allocated in this functon as not suitable
++    for reuse until the current level is exited.  */
++ 
++ void
++ mark_all_temps_used ()
++ {
++   struct temp_slot *p;
++ 
++   for (p = temp_slots; p; p = p->next)
++     {
++       p->in_use = 1;
++       p->level = MIN (p->level, temp_slot_level);
++     }
++ }
++ 
+  /* Push deeper into the nesting level for stack temporaries.  */
+  
+*************** pop_temp_slots ()
+*** 1208,1211 ****
+--- 1223,1237 ----
+    temp_slot_level--;
+  }
++ 
++ /* Initialize temporary slots.  */
++ 
++ void
++ init_temp_slots ()
++ {
++   /* We have not allocated any temporaries yet.  */
++   temp_slots = 0;
++   temp_slot_level = 0;
++   target_temp_slot_level = 0;
++ }
+  
+  /* Retroactively move an auto variable from a register to a stack slot.
+*************** instantiate_virtual_regs_1 (loc, object,
+*** 2838,2842 ****
+      case MEM:
+        /* Most cases of MEM that convert to valid addresses have already been
+! 	 handled by our scan of regno_reg_rtx.  The only special handling we
+  	 need here is to make a copy of the rtx to ensure it isn't being
+  	 shared if we have to change it to a pseudo. 
+--- 2864,2868 ----
+      case MEM:
+        /* Most cases of MEM that convert to valid addresses have already been
+! 	 handled by our scan of decls.  The only special handling we
+  	 need here is to make a copy of the rtx to ensure it isn't being
+  	 shared if we have to change it to a pseudo. 
+*************** instantiate_virtual_regs_1 (loc, object,
+*** 2896,2900 ****
+  	     has less restrictions on an address that some other insn.
+  	     In that case, we will modify the shared address.  This case
+! 	     doesn't seem very likely, though.  */
+  
+  	  if (instantiate_virtual_regs_1 (&XEXP (x, 0),
+--- 2922,2928 ----
+  	     has less restrictions on an address that some other insn.
+  	     In that case, we will modify the shared address.  This case
+! 	     doesn't seem very likely, though.  One case where this could
+! 	     happen is in the case of a USE or CLOBBER reference, but we
+! 	     take care of that below.  */
+  
+  	  if (instantiate_virtual_regs_1 (&XEXP (x, 0),
+*************** instantiate_virtual_regs_1 (loc, object,
+*** 2909,2914 ****
+  
+        /* Fall through to generic unary operation case.  */
+-     case USE:
+-     case CLOBBER:
+      case SUBREG:
+      case STRICT_LOW_PART:
+--- 2937,2940 ----
+*************** instantiate_virtual_regs_1 (loc, object,
+*** 2927,2930 ****
+--- 2953,2973 ----
+        goto restart;
+  
++     case USE:
++     case CLOBBER:
++       /* If the operand is a MEM, see if the change is a valid MEM.  If not,
++ 	 go ahead and make the invalid one, but do it to a copy.  For a REG,
++ 	 just make the recursive call, since there's no chance of a problem. */
++ 
++       if ((GET_CODE (XEXP (x, 0)) == MEM
++ 	   && instantiate_virtual_regs_1 (&XEXP (XEXP (x, 0), 0), XEXP (x, 0),
++ 					  0))
++ 	  || (GET_CODE (XEXP (x, 0)) == REG
++ 	      && instantiate_virtual_regs_1 (&XEXP (x, 0), 0, 0)))
++ 	return 1;
++ 
++       XEXP (x, 0) = copy_rtx (XEXP (x, 0));
++       loc = &XEXP (x, 0);
++       goto restart;
++ 
+      case REG:
+        /* Try to replace with a PLUS.  If that doesn't work, compute the sum
+*************** assign_parms (fndecl, second_time)
+*** 3404,3409 ****
+  
+  	  /* If this is a memory ref that contains aggregate components,
+! 	     mark it as such for cse and loop optimize.  */
+  	  MEM_IN_STRUCT_P (stack_parm) = aggregate;
+  	}
+  
+--- 3447,3454 ----
+  
+  	  /* If this is a memory ref that contains aggregate components,
+! 	     mark it as such for cse and loop optimize.  Likewise if it
+! 	     is readonly.  */
+  	  MEM_IN_STRUCT_P (stack_parm) = aggregate;
++ 	  RTX_UNCHANGING_P (stack_parm) = TREE_READONLY (parm);
+  	}
+  
+*************** assign_parms (fndecl, second_time)
+*** 3627,3631 ****
+  
+  	  parmreg = gen_reg_rtx (promoted_nominal_mode);
+! 	  REG_USERVAR_P (parmreg) = 1;
+  
+  	  /* If this was an item that we received a pointer to, set DECL_RTL
+--- 3672,3676 ----
+  
+  	  parmreg = gen_reg_rtx (promoted_nominal_mode);
+! 	  mark_user_reg (parmreg);
+  
+  	  /* If this was an item that we received a pointer to, set DECL_RTL
+*************** assign_parms (fndecl, second_time)
+*** 3695,3699 ****
+  		 Pmode above.  We must use the actual mode of the parm.  */
+  	      parmreg = gen_reg_rtx (TYPE_MODE (TREE_TYPE (parm)));
+! 	      REG_USERVAR_P (parmreg) = 1;
+  	      emit_move_insn (parmreg, DECL_RTL (parm));
+  	      DECL_RTL (parm) = parmreg;
+--- 3740,3744 ----
+  		 Pmode above.  We must use the actual mode of the parm.  */
+  	      parmreg = gen_reg_rtx (TYPE_MODE (TREE_TYPE (parm)));
+! 	      mark_user_reg (parmreg);
+  	      emit_move_insn (parmreg, DECL_RTL (parm));
+  	      DECL_RTL (parm) = parmreg;
+*************** init_function_start (subr, filename, lin
+*** 4814,4821 ****
+    rtl_expr_chain = 0;
+  
+!   /* We have not allocated any temporaries yet.  */
+!   temp_slots = 0;
+!   temp_slot_level = 0;
+!   target_temp_slot_level = 0;
+  
+    /* Within function body, compute a type's size as soon it is laid out.  */
+--- 4859,4864 ----
+    rtl_expr_chain = 0;
+  
+!   /* Set up to allocate temporaries.  */
+!   init_temp_slots ();
+  
+    /* Within function body, compute a type's size as soon it is laid out.  */
+diff -rcp2N gcc-2.7.2.2/gcc.c g77-new/gcc.c
+*** gcc-2.7.2.2/gcc.c	Tue Sep 12 17:15:11 1995
+--- g77-new/gcc.c	Sun Aug 10 18:47:14 1997
+*************** static int is_directory		PROTO((char *, 
+*** 296,300 ****
+  static void validate_switches	PROTO((char *));
+  static void validate_all_switches PROTO((void));
+! static void give_switch		PROTO((int, int));
+  static int used_arg		PROTO((char *, int));
+  static int default_arg		PROTO((char *, int));
+--- 296,300 ----
+  static void validate_switches	PROTO((char *));
+  static void validate_all_switches PROTO((void));
+! static void give_switch		PROTO((int, int, int));
+  static int used_arg		PROTO((char *, int));
+  static int default_arg		PROTO((char *, int));
+*************** or with constant text in a single argume
+*** 405,408 ****
+--- 405,409 ----
+  	name starts with `o'.  %{o*} would substitute this text,
+  	including the space; thus, two arguments would be generated.
++  %{^S*} likewise, but don't put a blank between a switch and any args.
+   %{S*:X} substitutes X if one or more switches whose names start with -S are
+  	specified to CC.  Note that the tail part of the -S option
+*************** process_command (argc, argv)
+*** 2828,2831 ****
+--- 2829,2835 ----
+  	  infiles[n_infiles++].name = argv[i];
+  	}
++       /* -save-temps overrides -pipe, so that temp files are produced */
++       else if (save_temps_flag && strcmp (argv[i], "-pipe") == 0)
++ 	;
+        else if (argv[i][0] == '-' && argv[i][1] != 0)
+  	{
+*************** handle_braces (p)
+*** 3832,3835 ****
+--- 3836,3844 ----
+    int negate = 0;
+    int suffix = 0;
++   int include_blanks = 1;
++ 
++   if (*p == '^')
++     /* A '^' after the open-brace means to not give blanks before args.  */
++     include_blanks = 0, ++p;
+  
+    if (*p == '|')
+*************** handle_braces (p)
+*** 3897,3901 ****
+  	if (!strncmp (switches[i].part1, filter, p - filter)
+  	    && check_live_switch (i, p - filter))
+! 	  give_switch (i, 0);
+      }
+    else
+--- 3906,3910 ----
+  	if (!strncmp (switches[i].part1, filter, p - filter)
+  	    && check_live_switch (i, p - filter))
+! 	  give_switch (i, 0, include_blanks);
+      }
+    else
+*************** handle_braces (p)
+*** 3936,3940 ****
+  		    do_spec_1 (string, 0, &switches[i].part1[hard_match_len]);
+  		    /* Pass any arguments this switch has.  */
+! 		    give_switch (i, 1);
+  		  }
+  
+--- 3945,3949 ----
+  		    do_spec_1 (string, 0, &switches[i].part1[hard_match_len]);
+  		    /* Pass any arguments this switch has.  */
+! 		    give_switch (i, 1, 1);
+  		  }
+  
+*************** handle_braces (p)
+*** 3980,3984 ****
+  	  if (*p == '}')
+  	    {
+! 	      give_switch (i, 0);
+  	    }
+  	  else
+--- 3989,3993 ----
+  	  if (*p == '}')
+  	    {
+! 	      give_switch (i, 0, include_blanks);
+  	    }
+  	  else
+*************** check_live_switch (switchnum, prefix_len
+*** 4081,4090 ****
+     This cannot fail since it never finishes a command line.
+  
+!    If OMIT_FIRST_WORD is nonzero, then we omit .part1 of the argument.  */
+  
+  static void
+! give_switch (switchnum, omit_first_word)
+       int switchnum;
+       int omit_first_word;
+  {
+    if (!omit_first_word)
+--- 4090,4103 ----
+     This cannot fail since it never finishes a command line.
+  
+!    If OMIT_FIRST_WORD is nonzero, then we omit .part1 of the argument.
+! 
+!    If INCLUDE_BLANKS is nonzero, then we include blanks before each argument
+!    of the switch.  */
+  
+  static void
+! give_switch (switchnum, omit_first_word, include_blanks)
+       int switchnum;
+       int omit_first_word;
++      int include_blanks;
+  {
+    if (!omit_first_word)
+*************** give_switch (switchnum, omit_first_word)
+*** 4093,4097 ****
+        do_spec_1 (switches[switchnum].part1, 1, NULL_PTR);
+      }
+!   do_spec_1 (" ", 0, NULL_PTR);
+    if (switches[switchnum].args != 0)
+      {
+--- 4106,4110 ----
+        do_spec_1 (switches[switchnum].part1, 1, NULL_PTR);
+      }
+! 
+    if (switches[switchnum].args != 0)
+      {
+*************** give_switch (switchnum, omit_first_word)
+*** 4099,4106 ****
+        for (p = switches[switchnum].args; *p; p++)
+  	{
+  	  do_spec_1 (*p, 1, NULL_PTR);
+- 	  do_spec_1 (" ", 0, NULL_PTR);
+  	}
+      }
+    switches[switchnum].valid = 1;
+  }
+--- 4112,4122 ----
+        for (p = switches[switchnum].args; *p; p++)
+  	{
++ 	  if (include_blanks)
++ 	    do_spec_1 (" ", 0, NULL_PTR);
+  	  do_spec_1 (*p, 1, NULL_PTR);
+  	}
+      }
++ 
++   do_spec_1 (" ", 0, NULL_PTR);
+    switches[switchnum].valid = 1;
+  }
+diff -rcp2N gcc-2.7.2.2/gcc.texi g77-new/gcc.texi
+*** gcc-2.7.2.2/gcc.texi	Thu Feb 20 19:24:19 1997
+--- g77-new/gcc.texi	Thu Jul 10 20:08:58 1997
+*************** original English.
+*** 149,152 ****
+--- 149,153 ----
+  @sp 3
+  @center Last updated 29 June 1996
++ @center (Revised for GNU Fortran 1997-01-10)
+  @sp 1
+  @c The version number appears twice more in this file.  
+diff -rcp2N gcc-2.7.2.2/glimits.h g77-new/glimits.h
+*** gcc-2.7.2.2/glimits.h	Wed Sep 29 17:30:54 1993
+--- g77-new/glimits.h	Thu Jul 10 20:08:58 1997
+***************
+*** 64,68 ****
+     (Same as `int').  */
+  #ifndef __LONG_MAX__
+! #define __LONG_MAX__ 2147483647L
+  #endif
+  #undef LONG_MIN
+--- 64,72 ----
+     (Same as `int').  */
+  #ifndef __LONG_MAX__
+! # ifndef __alpha__
+! #  define __LONG_MAX__ 2147483647L
+! # else
+! #  define __LONG_MAX__ 9223372036854775807LL
+! # endif /* __alpha__ */
+  #endif
+  #undef LONG_MIN
+diff -rcp2N gcc-2.7.2.2/integrate.c g77-new/integrate.c
+*** gcc-2.7.2.2/integrate.c	Fri Oct 20 18:48:13 1995
+--- g77-new/integrate.c	Sun Aug 10 18:46:31 1997
+*************** static rtx copy_for_inline	PROTO((rtx));
+*** 67,70 ****
+--- 67,71 ----
+  static void integrate_parm_decls PROTO((tree, struct inline_remap *, rtvec));
+  static void integrate_decl_tree	PROTO((tree, int, struct inline_remap *));
++ static void save_constants_in_decl_trees PROTO ((tree));
+  static void subst_constants	PROTO((rtx *, rtx, struct inline_remap *));
+  static void restore_constants	PROTO((rtx *));
+*************** save_for_inline_copying (fndecl)
+*** 435,438 ****
+--- 436,443 ----
+  	  }
+  
++       /* Also scan all decls, and replace any constant pool references with the
++ 	 actual constant.  */
++       save_constants_in_decl_trees (DECL_INITIAL (fndecl));
++ 
+        /* Clear out the constant pool so that we can recreate it with the
+  	 copied constants below.  */
+*************** save_for_inline_nocopy (fndecl)
+*** 781,784 ****
+--- 786,793 ----
+      }
+  
++   /* Also scan all decls, and replace any constant pool references with the
++      actual constant.  */
++   save_constants_in_decl_trees (DECL_INITIAL (fndecl));
++ 
+    /* We have now allocated all that needs to be allocated permanently
+       on the rtx obstack.  Set our high-water mark, so that we
+*************** expand_inline_function (fndecl, parms, t
+*** 1571,1575 ****
+        if (GET_CODE (XEXP (loc, 0)) == REG)
+  	{
+! 	  temp = force_reg (Pmode, structure_value_addr);
+  	  map->reg_map[REGNO (XEXP (loc, 0))] = temp;
+  	  if ((CONSTANT_P (structure_value_addr)
+--- 1580,1585 ----
+        if (GET_CODE (XEXP (loc, 0)) == REG)
+  	{
+! 	  temp = force_reg (Pmode,
+! 			    force_operand (structure_value_addr, NULL_RTX));
+  	  map->reg_map[REGNO (XEXP (loc, 0))] = temp;
+  	  if ((CONSTANT_P (structure_value_addr)
+*************** integrate_decl_tree (let, level, map)
+*** 2029,2032 ****
+--- 2039,2059 ----
+  	}
+      }
++ }
++ 
++ /* Given a BLOCK node LET, search for all DECL_RTL fields, and pass them
++    through save_constants.  */
++ 
++ static void
++ save_constants_in_decl_trees (let)
++      tree let;
++ {
++   tree t;
++ 
++   for (t = BLOCK_VARS (let); t; t = TREE_CHAIN (t))
++     if (DECL_RTL (t) != 0)
++       save_constants (&DECL_RTL (t));
++ 
++   for (t = BLOCK_SUBBLOCKS (let); t; t = TREE_CHAIN (t))
++     save_constants_in_decl_trees (t);
+  }
+  
+diff -rcp2N gcc-2.7.2.2/invoke.texi g77-new/invoke.texi
+*** gcc-2.7.2.2/invoke.texi	Tue Oct  3 11:40:43 1995
+--- g77-new/invoke.texi	Thu Jul 10 20:09:00 1997
+***************
+*** 1,3 ****
+! @c Copyright (C) 1988, 89, 92, 93, 94, 1995 Free Software Foundation, Inc.
+  @c This is part of the GCC manual.
+  @c For copying conditions, see the file gcc.texi.
+--- 1,3 ----
+! @c Copyright (C) 1988, 89, 92-95, 1997 Free Software Foundation, Inc.
+  @c This is part of the GCC manual.
+  @c For copying conditions, see the file gcc.texi.
+*************** in the following sections.
+*** 149,152 ****
+--- 149,153 ----
+  -fschedule-insns2  -fstrength-reduce  -fthread-jumps 
+  -funroll-all-loops  -funroll-loops
++ -fmove-all-movables  -freduce-all-givs  -frerun-loop-opt
+  -O  -O0  -O1  -O2  -O3
+  @end smallexample
+*************** in addition to the above:
+*** 331,334 ****
+--- 332,337 ----
+  -fshort-double  -fvolatile  -fvolatile-global
+  -fverbose-asm -fpack-struct +e0  +e1
++ -fargument-alias  -fargument-noalias
++ -fargument-noalias-global
+  @end smallexample
+  @end table
+*************** Print extra warning messages for these e
+*** 1253,1256 ****
+--- 1256,1304 ----
+  
+  @itemize @bullet
++ @cindex division by zero
++ @cindex zero, division by
++ @item
++ An integer division by zero is detected.
++ 
++ Some cases of division by zero might occur as the result
++ of using so-called ``safe'' macros.
++ For example:
++ 
++ @smallexample
++ #define BUCKETS(b) (((b) != NULL) ? (b)->buckets : 0)
++ @dots{...}
++   i = j / BUCKETS(b);
++ @end smallexample
++ 
++ Although analysis of the context of the above code could
++ prove that @samp{b} is never null when it is executed,
++ the division-by-zero warning is still useful, because
++ @code{gcc} generates code to do the division by zero at
++ run time so as to generate a run-time fault,
++ and tidy programmers will want to find ways to prevent
++ this needless code from being generated.
++ 
++ Note that @code{gcc} transforms expressions so as to find
++ opportunities for performing expensive operations
++ (such as division) at compile time instead of generating
++ code to perform them at run time.
++ For example, @code{gcc} transforms:
++ 
++ @smallexample
++ 2 / (i == 0)
++ @end smallexample
++ 
++ into:
++ 
++ @smallexample
++ (i == 0) ? (2 / 1) : (2 / 0)
++ @end smallexample
++ 
++ As a result, the division-by-zero warning might occur
++ in contexts where the divisor seems to be a non-constant.
++ It is useful in this case as well, because programmers might want
++ to clean up the code so the compiled code does not include
++ dead code to divide by zero.
++ 
+  @cindex @code{longjmp} warnings
+  @item
+*************** and usually makes programs run more slow
+*** 1941,1944 ****
+--- 1989,2037 ----
+  implies @samp{-fstrength-reduce} as well as @samp{-frerun-cse-after-loop}.
+  
++ @item -fmove-all-movables
++ Forces all invariant computations in loops to be moved
++ outside the loop.
++ This option is provided primarily to improve performance
++ for some Fortran code, though it might improve code written
++ in other languages.
++ 
++ @emph{Note:} When compiling programs written in Fortran,
++ this option is enabled by default.
++ 
++ Analysis of Fortran code optimization and the resulting
++ optimizations triggered by this option, and the
++ @samp{-freduce-all-givs} and @samp{-frerun-loop-opt}
++ options as well, were
++ contributed by Toon Moene (@code{toon@@moene.indiv.nluug.nl}).
++ 
++ These three options are intended to be removed someday, once
++ they have helped determine the efficacy of various
++ approaches to improving the performance of Fortran code.
++ 
++ Please let us (@code{fortran@@gnu.ai.mit.edu})
++ know how use of these options affects
++ the performance of your production code.
++ We're very interested in code that runs @emph{slower}
++ when these options are @emph{enabled}.
++ 
++ @item -freduce-all-givs
++ Forces all general-induction variables in loops to be
++ strength-reduced.
++ This option is provided primarily to improve performance
++ for some Fortran code, though it might improve code written
++ in other languages.
++ 
++ @emph{Note:} When compiling programs written in Fortran,
++ this option is enabled by default.
++ 
++ @item -frerun-loop-opt
++ Runs loop optimizations a second time.
++ This option is provided primarily to improve performance
++ for some Fortran code, though it might improve code written
++ in other languages.
++ 
++ @emph{Note:} When compiling programs written in Fortran,
++ this option is enabled by default.
++ 
+  @item -fno-peephole
+  Disable any machine-specific peephole optimizations.
+*************** compilation).
+*** 4229,4232 ****
+--- 4322,4397 ----
+  With @samp{+e1}, G++ actually generates the code implementing virtual
+  functions defined in the code, and makes them publicly visible.
++ 
++ @cindex aliasing of parameters
++ @cindex parameters, aliased
++ @item -fargument-alias
++ @item -fargument-noalias
++ @item -fargument-noalias-global
++ Specify the possible relationships among parameters and between
++ parameters and global data.
++ 
++ @samp{-fargument-alias} specifies that arguments (parameters) may
++ alias each other and may alias global storage.
++ @samp{-fargument-noalias} specifies that arguments do not alias
++ each other, but may alias global storage.
++ @samp{-fargument-noalias-global} specifies that arguments do not
++ alias each other and do not alias global storage.
++ 
++ For code written in C, C++, and Objective-C, @samp{-fargument-alias}
++ is the default.
++ For code written in Fortran, @samp{-fargument-noalias-global} is
++ the default, though this is pertinent only on systems where
++ @code{g77} is installed.
++ (See the documentation for other compilers for information on the
++ defaults for their respective languages.)
++ 
++ Normally, @code{gcc} assumes that a write through a pointer
++ passed as a parameter to the current function might modify a
++ value pointed to by another pointer passed as a parameter, or
++ in global storage.
++ 
++ For example, consider this code:
++ 
++ @example
++ void x(int *i, int *j)
++ @{
++   extern int k;
++ 
++   ++*i;
++   ++*j;
++   ++k;
++ @}
++ @end example
++ 
++ When compiling the above function, @code{gcc} assumes that @samp{i} might
++ be a pointer to the same variable as @samp{j}, and that either @samp{i},
++ @samp{j}, or both might be a pointer to @samp{k}.
++ 
++ Therefore, @code{gcc} does not assume it can generate code to read
++ @samp{*i}, @samp{*j}, and @samp{k} into separate registers, increment
++ each register, then write the incremented values back out.
++ 
++ Instead, @code{gcc} must generate code that reads @samp{*i},
++ increments it, and writes it back before reading @samp{*j},
++ in case @samp{i} and @samp{j} are aliased, and, similarly,
++ that writes @samp{*j} before reading @samp{k}.
++ The result is code that, on many systems, takes longer to execute,
++ due to the way many processors schedule instruction execution.
++ 
++ Compiling the above code with the @samp{-fargument-noalias} option
++ allows @code{gcc} to assume that @samp{i} and @samp{j} do not alias
++ each other, but either might alias @samp{k}.
++ 
++ Compiling the above code with the @samp{-fargument-noalias-global}
++ option allows @code{gcc} to assume that no combination of @samp{i},
++ @samp{j}, and @samp{k} are aliases for each other.
++ 
++ @emph{Note:} Use the @samp{-fargument-noalias} and
++ @samp{-fargument-noalias-global} options with care.
++ While they can result in faster executables, they can
++ also result in executables with subtle bugs, bugs that
++ show up only when compiled for specific target systems,
++ or bugs that show up only when compiled by specific versions
++ of @code{g77}.
+  @end table
+  
+diff -rcp2N gcc-2.7.2.2/libgcc2.c g77-new/libgcc2.c
+*** gcc-2.7.2.2/libgcc2.c	Sun Nov 26 14:39:21 1995
+--- g77-new/libgcc2.c	Sun Aug 10 18:46:07 1997
+*************** __gcc_bcmp (s1, s2, size)
+*** 1193,1196 ****
+--- 1193,1201 ----
+  #endif
+  
++ #ifdef L__dummy
++ void
++ __dummy () {}
++ #endif
++ 
+  #ifdef L_varargs
+  #ifdef __i860__
+diff -rcp2N gcc-2.7.2.2/local-alloc.c g77-new/local-alloc.c
+*** gcc-2.7.2.2/local-alloc.c	Mon Aug 21 13:15:44 1995
+--- g77-new/local-alloc.c	Sun Aug 10 18:46:10 1997
+*************** static int this_insn_number;
+*** 243,246 ****
+--- 243,250 ----
+  static rtx this_insn;
+  
++ /* Used to communicate changes made by update_equiv_regs to
++    memref_referenced_p.  */
++ static rtx *reg_equiv_replacement;
++ 
+  static void alloc_qty		PROTO((int, enum machine_mode, int, int));
+  static void alloc_qty_for_scratch PROTO((rtx, int, rtx, int, int));
+*************** validate_equiv_mem_from_store (dest, set
+*** 545,549 ****
+         && reg_overlap_mentioned_p (dest, equiv_mem))
+        || (GET_CODE (dest) == MEM
+! 	  && true_dependence (dest, equiv_mem)))
+      equiv_mem_modified = 1;
+  }
+--- 549,553 ----
+         && reg_overlap_mentioned_p (dest, equiv_mem))
+        || (GET_CODE (dest) == MEM
+! 	  && true_dependence (dest, VOIDmode, equiv_mem, rtx_varies_p)))
+      equiv_mem_modified = 1;
+  }
+*************** memref_referenced_p (memref, x)
+*** 617,621 ****
+    switch (code)
+      {
+-     case REG:
+      case CONST_INT:
+      case CONST:
+--- 621,624 ----
+*************** memref_referenced_p (memref, x)
+*** 629,634 ****
+        return 0;
+  
+      case MEM:
+!       if (true_dependence (memref, x))
+  	return 1;
+        break;
+--- 632,642 ----
+        return 0;
+  
++     case REG:
++       return (reg_equiv_replacement[REGNO (x)] == 0
++ 	      || memref_referenced_p (memref,
++ 				      reg_equiv_replacement[REGNO (x)]));
++ 
+      case MEM:
+!       if (true_dependence (memref, VOIDmode, x, rtx_varies_p))
+  	return 1;
+        break;
+*************** optimize_reg_copy_1 (insn, dest, src)
+*** 818,827 ****
+  	      if (sregno >= FIRST_PSEUDO_REGISTER)
+  		{
+! 		  reg_live_length[sregno] -= length;
+! 		  /* reg_live_length is only an approximation after combine
+! 		     if sched is not run, so make sure that we still have
+! 		     a reasonable value.  */
+! 		  if (reg_live_length[sregno] < 2)
+! 		    reg_live_length[sregno] = 2;
+  		  reg_n_calls_crossed[sregno] -= n_calls;
+  		}
+--- 826,839 ----
+  	      if (sregno >= FIRST_PSEUDO_REGISTER)
+  		{
+! 		  if (reg_live_length[sregno] >= 0)
+! 		    {
+! 		      reg_live_length[sregno] -= length;
+! 		      /* reg_live_length is only an approximation after
+! 			 combine if sched is not run, so make sure that we
+! 			 still have a reasonable value.  */
+! 		      if (reg_live_length[sregno] < 2)
+! 			reg_live_length[sregno] = 2;
+! 		    }
+! 
+  		  reg_n_calls_crossed[sregno] -= n_calls;
+  		}
+*************** optimize_reg_copy_1 (insn, dest, src)
+*** 829,833 ****
+  	      if (dregno >= FIRST_PSEUDO_REGISTER)
+  		{
+! 		  reg_live_length[dregno] += d_length;
+  		  reg_n_calls_crossed[dregno] += d_n_calls;
+  		}
+--- 841,847 ----
+  	      if (dregno >= FIRST_PSEUDO_REGISTER)
+  		{
+! 		  if (reg_live_length[dregno] >= 0)
+! 		    reg_live_length[dregno] += d_length;
+! 
+  		  reg_n_calls_crossed[dregno] += d_n_calls;
+  		}
+*************** update_equiv_regs ()
+*** 948,953 ****
+  {
+    rtx *reg_equiv_init_insn = (rtx *) alloca (max_regno * sizeof (rtx *));
+-   rtx *reg_equiv_replacement = (rtx *) alloca (max_regno * sizeof (rtx *));
+    rtx insn;
+  
+    bzero ((char *) reg_equiv_init_insn, max_regno * sizeof (rtx *));
+--- 962,968 ----
+  {
+    rtx *reg_equiv_init_insn = (rtx *) alloca (max_regno * sizeof (rtx *));
+    rtx insn;
++ 
++   reg_equiv_replacement = (rtx *) alloca (max_regno * sizeof (rtx *));
+  
+    bzero ((char *) reg_equiv_init_insn, max_regno * sizeof (rtx *));
+diff -rcp2N gcc-2.7.2.2/loop.c g77-new/loop.c
+*** gcc-2.7.2.2/loop.c	Thu Feb 20 19:24:20 1997
+--- g77-new/loop.c	Sun Aug 10 18:46:43 1997
+*************** int *loop_number_exit_count;
+*** 111,116 ****
+  unsigned HOST_WIDE_INT loop_n_iterations;
+  
+! /* Nonzero if there is a subroutine call in the current loop.
+!    (unknown_address_altered is also nonzero in this case.)  */
+  
+  static int loop_has_call;
+--- 111,115 ----
+  unsigned HOST_WIDE_INT loop_n_iterations;
+  
+! /* Nonzero if there is a subroutine call in the current loop.  */
+  
+  static int loop_has_call;
+*************** static char *moved_once;
+*** 160,164 ****
+     here, we just turn on unknown_address_altered.  */
+  
+! #define NUM_STORES 20
+  static rtx loop_store_mems[NUM_STORES];
+  
+--- 159,163 ----
+     here, we just turn on unknown_address_altered.  */
+  
+! #define NUM_STORES 30
+  static rtx loop_store_mems[NUM_STORES];
+  
+*************** scan_loop (loop_start, end, nregs)
+*** 669,673 ****
+  	    {
+  	      temp = find_reg_note (p, REG_EQUAL, NULL_RTX);
+! 	      if (temp && CONSTANT_P (XEXP (temp, 0)))
+  		src = XEXP (temp, 0), move_insn = 1;
+  	      if (temp && find_reg_note (p, REG_RETVAL, NULL_RTX))
+--- 668,673 ----
+  	    {
+  	      temp = find_reg_note (p, REG_EQUAL, NULL_RTX);
+! 	      if (temp && CONSTANT_P (XEXP (temp, 0))
+! 		  && LEGITIMATE_CONSTANT_P (XEXP (temp, 0)))
+  		src = XEXP (temp, 0), move_insn = 1;
+  	      if (temp && find_reg_note (p, REG_RETVAL, NULL_RTX))
+*************** move_movables (movables, threshold, insn
+*** 1629,1632 ****
+--- 1629,1633 ----
+  
+  	  if (already_moved[regno]
++ 	      || flag_move_all_movables
+  	      || (threshold * savings * m->lifetime) >= insn_count
+  	      || (m->forces && m->forces->done
+*************** prescan_loop (start, end)
+*** 2199,2203 ****
+        else if (GET_CODE (insn) == CALL_INSN)
+  	{
+! 	  unknown_address_altered = 1;
+  	  loop_has_call = 1;
+  	}
+--- 2200,2205 ----
+        else if (GET_CODE (insn) == CALL_INSN)
+  	{
+! 	  if (! CONST_CALL_P (insn))
+! 	    unknown_address_altered = 1;
+  	  loop_has_call = 1;
+  	}
+*************** invariant_p (x)
+*** 2777,2781 ****
+        /* See if there is any dependence between a store and this load.  */
+        for (i = loop_store_mems_idx - 1; i >= 0; i--)
+! 	if (true_dependence (loop_store_mems[i], x))
+  	  return 0;
+  
+--- 2779,2783 ----
+        /* See if there is any dependence between a store and this load.  */
+        for (i = loop_store_mems_idx - 1; i >= 0; i--)
+! 	if (true_dependence (loop_store_mems[i], VOIDmode, x, rtx_varies_p))
+  	  return 0;
+  
+*************** strength_reduce (scan_start, end, loop_t
+*** 3821,3826 ****
+  	     exit.  */
+  
+! 	  if (v->lifetime * threshold * benefit < insn_count
+! 	      && ! bl->reversed)
+  	    {
+  	      if (loop_dump_stream)
+--- 3823,3828 ----
+  	     exit.  */
+  
+! 	  if ( ! flag_reduce_all_givs && v->lifetime * threshold * benefit < insn_count
+! 	      && ! bl->reversed )
+  	    {
+  	      if (loop_dump_stream)
+*************** record_giv (v, insn, src_reg, dest_reg, 
+*** 4375,4378 ****
+--- 4377,4382 ----
+    v->final_value = 0;
+    v->same_insn = 0;
++   v->unrolled = 0;
++   v->shared = 0;
+  
+    /* The v->always_computable field is used in update_giv_derive, to
+*************** check_final_value (v, loop_start, loop_e
+*** 4652,4657 ****
+  	      if (GET_CODE (p) == JUMP_INSN && JUMP_LABEL (p)
+  		  && LABEL_NAME (JUMP_LABEL (p))
+! 		  && ((INSN_LUID (JUMP_LABEL (p)) < INSN_LUID (v->insn)
+! 		       && INSN_LUID (JUMP_LABEL (p)) > INSN_LUID (loop_start))
+  		      || (INSN_LUID (JUMP_LABEL (p)) > INSN_LUID (last_giv_use)
+  			  && INSN_LUID (JUMP_LABEL (p)) < INSN_LUID (loop_end))))
+--- 4656,4664 ----
+  	      if (GET_CODE (p) == JUMP_INSN && JUMP_LABEL (p)
+  		  && LABEL_NAME (JUMP_LABEL (p))
+! 		  && ((INSN_UID (JUMP_LABEL (p)) >= max_uid_for_loop)
+! 		      || (INSN_UID (v->insn) >= max_uid_for_loop)
+! 		      || (INSN_UID (last_giv_use) >= max_uid_for_loop)
+! 		      || (INSN_LUID (JUMP_LABEL (p)) < INSN_LUID (v->insn)
+! 			  && INSN_LUID (JUMP_LABEL (p)) > INSN_LUID (loop_start))
+  		      || (INSN_LUID (JUMP_LABEL (p)) > INSN_LUID (last_giv_use)
+  			  && INSN_LUID (JUMP_LABEL (p)) < INSN_LUID (loop_end))))
+*************** emit_iv_add_mult (b, m, a, reg, insert_b
+*** 5560,5563 ****
+--- 5567,5572 ----
+  
+    emit_insn_before (seq, insert_before);
++ 
++   record_base_value (REGNO (reg), b);
+  }
+  
+diff -rcp2N gcc-2.7.2.2/loop.h g77-new/loop.h
+*** gcc-2.7.2.2/loop.h	Fri Jul 14 08:23:28 1995
+--- g77-new/loop.h	Thu Jul 10 20:09:03 1997
+*************** struct induction
+*** 89,92 ****
+--- 89,95 ----
+  				   we won't use it to eliminate a biv, it
+  				   would probably lose. */
++   unsigned unrolled : 1;	/* 1 if new register has been allocated in
++ 				   unrolled loop.  */
++   unsigned shared : 1;
+    int lifetime;			/* Length of life of this giv */
+    int times_used;		/* # times this giv is used. */
+diff -rcp2N gcc-2.7.2.2/real.c g77-new/real.c
+*** gcc-2.7.2.2/real.c	Tue Aug 15 17:57:18 1995
+--- g77-new/real.c	Thu Jul 10 20:09:04 1997
+*************** make_nan (nan, sign, mode)
+*** 5625,5633 ****
+  }
+  
+! /* Convert an SFmode target `float' value to a REAL_VALUE_TYPE.
+!    This is the inverse of the function `etarsingle' invoked by
+     REAL_VALUE_TO_TARGET_SINGLE.  */
+  
+  REAL_VALUE_TYPE
+  ereal_from_float (f)
+       HOST_WIDE_INT f;
+--- 5625,5699 ----
+  }
+  
+! /* This is the inverse of the function `etarsingle' invoked by
+     REAL_VALUE_TO_TARGET_SINGLE.  */
+  
+  REAL_VALUE_TYPE
++ ereal_unto_float (f)
++      long f;
++ {
++   REAL_VALUE_TYPE r;
++   unsigned EMUSHORT s[2];
++   unsigned EMUSHORT e[NE];
++ 
++   /* Convert 32 bit integer to array of 16 bit pieces in target machine order.
++    This is the inverse operation to what the function `endian' does.  */
++   if (REAL_WORDS_BIG_ENDIAN)
++     {
++       s[0] = (unsigned EMUSHORT) (f >> 16);
++       s[1] = (unsigned EMUSHORT) f;
++     }
++   else
++     {
++       s[0] = (unsigned EMUSHORT) f;
++       s[1] = (unsigned EMUSHORT) (f >> 16);
++     }
++   /* Convert and promote the target float to E-type. */
++   e24toe (s, e);
++   /* Output E-type to REAL_VALUE_TYPE. */
++   PUT_REAL (e, &r);
++   return r;
++ }
++ 
++ 
++ /* This is the inverse of the function `etardouble' invoked by
++    REAL_VALUE_TO_TARGET_DOUBLE.  */
++ 
++ REAL_VALUE_TYPE
++ ereal_unto_double (d)
++      long d[];
++ {
++   REAL_VALUE_TYPE r;
++   unsigned EMUSHORT s[4];
++   unsigned EMUSHORT e[NE];
++ 
++   /* Convert array of HOST_WIDE_INT to equivalent array of 16-bit pieces.  */
++   if (REAL_WORDS_BIG_ENDIAN)
++     {
++       s[0] = (unsigned EMUSHORT) (d[0] >> 16);
++       s[1] = (unsigned EMUSHORT) d[0];
++       s[2] = (unsigned EMUSHORT) (d[1] >> 16);
++       s[3] = (unsigned EMUSHORT) d[1];
++     }
++   else
++     {
++       /* Target float words are little-endian.  */
++       s[0] = (unsigned EMUSHORT) d[0];
++       s[1] = (unsigned EMUSHORT) (d[0] >> 16);
++       s[2] = (unsigned EMUSHORT) d[1];
++       s[3] = (unsigned EMUSHORT) (d[1] >> 16);
++     }
++   /* Convert target double to E-type. */
++   e53toe (s, e);
++   /* Output E-type to REAL_VALUE_TYPE. */
++   PUT_REAL (e, &r);
++   return r;
++ }
++ 
++ 
++ /* Convert an SFmode target `float' value to a REAL_VALUE_TYPE.
++    This is somewhat like ereal_unto_float, but the input types
++    for these are different.  */
++ 
++ REAL_VALUE_TYPE
+  ereal_from_float (f)
+       HOST_WIDE_INT f;
+*************** ereal_from_float (f)
+*** 5658,5663 ****
+  
+  /* Convert a DFmode target `double' value to a REAL_VALUE_TYPE.
+!    This is the inverse of the function `etardouble' invoked by
+!    REAL_VALUE_TO_TARGET_DOUBLE.
+  
+     The DFmode is stored as an array of HOST_WIDE_INT in the target's
+--- 5724,5729 ----
+  
+  /* Convert a DFmode target `double' value to a REAL_VALUE_TYPE.
+!    This is somewhat like ereal_unto_double, but the input types
+!    for these are different.
+  
+     The DFmode is stored as an array of HOST_WIDE_INT in the target's
+diff -rcp2N gcc-2.7.2.2/real.h g77-new/real.h
+*** gcc-2.7.2.2/real.h	Thu Jun 15 07:57:56 1995
+--- g77-new/real.h	Thu Jul 10 20:09:05 1997
+*************** extern void ereal_to_decimal	PROTO((REAL
+*** 152,155 ****
+--- 152,157 ----
+  extern int ereal_cmp		PROTO((REAL_VALUE_TYPE, REAL_VALUE_TYPE));
+  extern int ereal_isneg		PROTO((REAL_VALUE_TYPE));
++ extern REAL_VALUE_TYPE ereal_unto_float PROTO((long));
++ extern REAL_VALUE_TYPE ereal_unto_double PROTO((long *));
+  extern REAL_VALUE_TYPE ereal_from_float PROTO((HOST_WIDE_INT));
+  extern REAL_VALUE_TYPE ereal_from_double PROTO((HOST_WIDE_INT *));
+*************** extern REAL_VALUE_TYPE real_value_trunca
+*** 197,200 ****
+--- 199,208 ----
+  /* IN is a REAL_VALUE_TYPE.  OUT is a long. */
+  #define REAL_VALUE_TO_TARGET_SINGLE(IN, OUT) ((OUT) = etarsingle ((IN)))
++ 
++ /* Inverse of REAL_VALUE_TO_TARGET_DOUBLE. */
++ #define REAL_VALUE_UNTO_TARGET_DOUBLE(d)  (ereal_unto_double (d))
++ 
++ /* Inverse of REAL_VALUE_TO_TARGET_SINGLE. */
++ #define REAL_VALUE_UNTO_TARGET_SINGLE(f)  (ereal_unto_float (f))
+  
+  /* d is an array of HOST_WIDE_INT that holds a double precision
+diff -rcp2N gcc-2.7.2.2/recog.c g77-new/recog.c
+*** gcc-2.7.2.2/recog.c	Sat Jul  1 06:52:35 1995
+--- g77-new/recog.c	Sun Aug 10 18:46:55 1997
+*************** register_operand (op, mode)
+*** 872,876 ****
+  				REGNO (SUBREG_REG (op)))
+  	  && (GET_MODE_SIZE (mode)
+! 	      != GET_MODE_SIZE (GET_MODE (SUBREG_REG (op)))))
+  	return 0;
+  #endif
+--- 872,878 ----
+  				REGNO (SUBREG_REG (op)))
+  	  && (GET_MODE_SIZE (mode)
+! 	      != GET_MODE_SIZE (GET_MODE (SUBREG_REG (op))))
+! 	  && GET_MODE_CLASS (GET_MODE (SUBREG_REG (op))) != MODE_COMPLEX_INT
+! 	  && GET_MODE_CLASS (GET_MODE (SUBREG_REG (op))) != MODE_COMPLEX_FLOAT)
+  	return 0;
+  #endif
+diff -rcp2N gcc-2.7.2.2/reload.c g77-new/reload.c
+*** gcc-2.7.2.2/reload.c	Sat Nov 11 08:23:54 1995
+--- g77-new/reload.c	Sun Aug 10 04:58:03 1997
+***************
+*** 1,4 ****
+  /* Search an insn for pseudo regs that must be in hard regs and are not.
+!    Copyright (C) 1987, 88, 89, 92, 93, 94, 1995 Free Software Foundation, Inc.
+  
+  This file is part of GNU CC.
+--- 1,4 ----
+  /* Search an insn for pseudo regs that must be in hard regs and are not.
+!    Copyright (C) 1987, 88, 89, 92-5, 1996 Free Software Foundation, Inc.
+  
+  This file is part of GNU CC.
+*************** static int push_secondary_reload PROTO((
+*** 292,295 ****
+--- 292,296 ----
+  					enum machine_mode, enum reload_type,
+  					enum insn_code *));
++ static enum reg_class find_valid_class PROTO((enum machine_mode, int));
+  static int push_reload		PROTO((rtx, rtx, rtx *, rtx *, enum reg_class,
+  				       enum machine_mode, enum machine_mode,
+*************** static struct decomposition decompose PR
+*** 305,312 ****
+  static int immune_p		PROTO((rtx, rtx, struct decomposition));
+  static int alternative_allows_memconst PROTO((char *, int));
+! static rtx find_reloads_toplev	PROTO((rtx, int, enum reload_type, int, int));
+  static rtx make_memloc		PROTO((rtx, int));
+  static int find_reloads_address	PROTO((enum machine_mode, rtx *, rtx, rtx *,
+! 				       int, enum reload_type, int));
+  static rtx subst_reg_equivs	PROTO((rtx));
+  static rtx subst_indexed_address PROTO((rtx));
+--- 306,313 ----
+  static int immune_p		PROTO((rtx, rtx, struct decomposition));
+  static int alternative_allows_memconst PROTO((char *, int));
+! static rtx find_reloads_toplev	PROTO((rtx, int, enum reload_type, int, int, short *));
+  static rtx make_memloc		PROTO((rtx, int));
+  static int find_reloads_address	PROTO((enum machine_mode, rtx *, rtx, rtx *,
+! 				       int, enum reload_type, int, short *));
+  static rtx subst_reg_equivs	PROTO((rtx));
+  static rtx subst_indexed_address PROTO((rtx));
+*************** push_secondary_reload (in_p, x, opnum, o
+*** 590,599 ****
+  
+        if (in_p && icode == CODE_FOR_nothing
+! 	  && SECONDARY_MEMORY_NEEDED (class, reload_class, reload_mode))
+! 	get_secondary_mem (x, reload_mode, opnum, type);
+  
+        if (! in_p && icode == CODE_FOR_nothing
+! 	  && SECONDARY_MEMORY_NEEDED (reload_class, class, reload_mode))
+! 	get_secondary_mem (x, reload_mode, opnum, type);
+  #endif
+      }
+--- 591,600 ----
+  
+        if (in_p && icode == CODE_FOR_nothing
+! 	  && SECONDARY_MEMORY_NEEDED (class, reload_class, mode))
+! 	get_secondary_mem (x, mode, opnum, type);
+  
+        if (! in_p && icode == CODE_FOR_nothing
+! 	  && SECONDARY_MEMORY_NEEDED (reload_class, class, mode))
+! 	get_secondary_mem (x, mode, opnum, type);
+  #endif
+      }
+*************** get_secondary_mem (x, mode, opnum, type)
+*** 673,677 ****
+  
+        find_reloads_address (mode, NULL_PTR, XEXP (loc, 0), &XEXP (loc, 0),
+! 			    opnum, type, 0);
+      }
+  
+--- 674,678 ----
+  
+        find_reloads_address (mode, NULL_PTR, XEXP (loc, 0), &XEXP (loc, 0),
+! 			    opnum, type, 0, NULL);
+      }
+  
+*************** clear_secondary_mem ()
+*** 689,692 ****
+--- 690,725 ----
+  #endif /* SECONDARY_MEMORY_NEEDED */
+  
++ /* Find the largest class for which every register number plus N is valid in
++    M1 (if in range).  Abort if no such class exists.  */
++ 
++ static enum reg_class
++ find_valid_class (m1, n)
++      enum machine_mode  m1;
++      int n;
++ {
++   int class;
++   int regno;
++   enum reg_class best_class;
++   int best_size = 0;
++ 
++   for (class = 1; class < N_REG_CLASSES; class++)
++     {
++       int bad = 0;
++       for (regno = 0; regno < FIRST_PSEUDO_REGISTER && ! bad; regno++)
++ 	if (TEST_HARD_REG_BIT (reg_class_contents[class], regno)
++ 	    && TEST_HARD_REG_BIT (reg_class_contents[class], regno + n)
++ 	    && ! HARD_REGNO_MODE_OK (regno + n, m1))
++ 	  bad = 1;
++ 
++       if (! bad && reg_class_size[class] > best_size)
++ 	best_class = class, best_size = reg_class_size[class];
++     }
++ 
++   if (best_size == 0)
++     abort ();
++ 
++   return best_class;
++ }
++ 
+  /* Record one reload that needs to be performed.
+     IN is an rtx saying where the data are to be found before this instruction.
+*************** push_reload (in, out, inloc, outloc, cla
+*** 894,898 ****
+        && GET_CODE (SUBREG_REG (in)) == REG
+        && REGNO (SUBREG_REG (in)) < FIRST_PSEUDO_REGISTER
+!       && (! HARD_REGNO_MODE_OK (REGNO (SUBREG_REG (in)), inmode)
+  	  || (GET_MODE_SIZE (inmode) <= UNITS_PER_WORD
+  	      && (GET_MODE_SIZE (GET_MODE (SUBREG_REG (in)))
+--- 927,932 ----
+        && GET_CODE (SUBREG_REG (in)) == REG
+        && REGNO (SUBREG_REG (in)) < FIRST_PSEUDO_REGISTER
+!       && (! HARD_REGNO_MODE_OK (REGNO (SUBREG_REG (in)) + SUBREG_WORD (in),
+! 				inmode)
+  	  || (GET_MODE_SIZE (inmode) <= UNITS_PER_WORD
+  	      && (GET_MODE_SIZE (GET_MODE (SUBREG_REG (in)))
+*************** push_reload (in, out, inloc, outloc, cla
+*** 909,913 ****
+  	 output before the outer reload.  */
+        push_reload (SUBREG_REG (in), NULL_RTX, &SUBREG_REG (in), NULL_PTR,
+! 		   GENERAL_REGS, VOIDmode, VOIDmode, 0, 0, opnum, type);
+        dont_remove_subreg = 1;
+      }
+--- 943,948 ----
+  	 output before the outer reload.  */
+        push_reload (SUBREG_REG (in), NULL_RTX, &SUBREG_REG (in), NULL_PTR,
+! 		   find_valid_class (inmode, SUBREG_WORD (in)),
+! 		   VOIDmode, VOIDmode, 0, 0, opnum, type);
+        dont_remove_subreg = 1;
+      }
+*************** push_reload (in, out, inloc, outloc, cla
+*** 982,986 ****
+        && GET_CODE (SUBREG_REG (out)) == REG
+        && REGNO (SUBREG_REG (out)) < FIRST_PSEUDO_REGISTER
+!       && (! HARD_REGNO_MODE_OK (REGNO (SUBREG_REG (out)), outmode)
+  	  || (GET_MODE_SIZE (outmode) <= UNITS_PER_WORD
+  	      && (GET_MODE_SIZE (GET_MODE (SUBREG_REG (out)))
+--- 1017,1022 ----
+        && GET_CODE (SUBREG_REG (out)) == REG
+        && REGNO (SUBREG_REG (out)) < FIRST_PSEUDO_REGISTER
+!       && (! HARD_REGNO_MODE_OK (REGNO (SUBREG_REG (out)) + SUBREG_WORD (out),
+! 				outmode)
+  	  || (GET_MODE_SIZE (outmode) <= UNITS_PER_WORD
+  	      && (GET_MODE_SIZE (GET_MODE (SUBREG_REG (out)))
+*************** push_reload (in, out, inloc, outloc, cla
+*** 998,1002 ****
+        dont_remove_subreg = 1;
+        push_reload (SUBREG_REG (out), SUBREG_REG (out), &SUBREG_REG (out),
+! 		   &SUBREG_REG (out), ALL_REGS, VOIDmode, VOIDmode, 0, 0,
+  		   opnum, RELOAD_OTHER);
+      }
+--- 1034,1040 ----
+        dont_remove_subreg = 1;
+        push_reload (SUBREG_REG (out), SUBREG_REG (out), &SUBREG_REG (out),
+! 		   &SUBREG_REG (out),
+! 		   find_valid_class (outmode, SUBREG_WORD (out)),
+! 		   VOIDmode, VOIDmode, 0, 0,
+  		   opnum, RELOAD_OTHER);
+      }
+*************** find_reloads (insn, replace, ind_levels,
+*** 2241,2244 ****
+--- 2279,2283 ----
+    int goal_earlyclobber, this_earlyclobber;
+    enum machine_mode operand_mode[MAX_RECOG_OPERANDS];
++   short force_update[MAX_RECOG_OPERANDS];
+  
+    this_insn = insn;
+*************** find_reloads (insn, replace, ind_levels,
+*** 2272,2275 ****
+--- 2311,2316 ----
+  #endif
+  
++   bzero ((char *) force_update, sizeof force_update);
++ 
+    /* Find what kind of insn this is.  NOPERANDS gets number of operands.
+       Make OPERANDS point to a vector of operand values.
+*************** find_reloads (insn, replace, ind_levels,
+*** 2469,2473 ****
+  	  find_reloads_address (VOIDmode, NULL_PTR,
+  				recog_operand[i], recog_operand_loc[i],
+! 				i, operand_type[i], ind_levels);
+  	  substed_operand[i] = recog_operand[i] = *recog_operand_loc[i];
+  	}
+--- 2510,2515 ----
+  	  find_reloads_address (VOIDmode, NULL_PTR,
+  				recog_operand[i], recog_operand_loc[i],
+! 				i, operand_type[i], ind_levels,
+! 				&force_update[i]);
+  	  substed_operand[i] = recog_operand[i] = *recog_operand_loc[i];
+  	}
+*************** find_reloads (insn, replace, ind_levels,
+*** 2478,2482 ****
+  				    XEXP (recog_operand[i], 0),
+  				    &XEXP (recog_operand[i], 0),
+! 				    i, address_type[i], ind_levels))
+  	    address_reloaded[i] = 1;
+  	  substed_operand[i] = recog_operand[i] = *recog_operand_loc[i];
+--- 2520,2525 ----
+  				    XEXP (recog_operand[i], 0),
+  				    &XEXP (recog_operand[i], 0),
+! 				    i, address_type[i], ind_levels,
+! 				    &force_update[i]))
+  	    address_reloaded[i] = 1;
+  	  substed_operand[i] = recog_operand[i] = *recog_operand_loc[i];
+*************** find_reloads (insn, replace, ind_levels,
+*** 2487,2491 ****
+  				 ind_levels,
+  				 set != 0
+! 				 && &SET_DEST (set) == recog_operand_loc[i]);
+        else if (code == PLUS)
+  	/* We can get a PLUS as an "operand" as a result of
+--- 2530,2535 ----
+  				 ind_levels,
+  				 set != 0
+! 				 && &SET_DEST (set) == recog_operand_loc[i],
+! 				 &force_update[i]);
+        else if (code == PLUS)
+  	/* We can get a PLUS as an "operand" as a result of
+*************** find_reloads (insn, replace, ind_levels,
+*** 2493,2497 ****
+  	substed_operand[i] = recog_operand[i] = *recog_operand_loc[i]
+  	  = find_reloads_toplev (recog_operand[i], i, address_type[i],
+! 				 ind_levels, 0);
+        else if (code == REG)
+  	{
+--- 2537,2541 ----
+  	substed_operand[i] = recog_operand[i] = *recog_operand_loc[i]
+  	  = find_reloads_toplev (recog_operand[i], i, address_type[i],
+! 				 ind_levels, 0, &force_update[i]);
+        else if (code == REG)
+  	{
+*************** find_reloads (insn, replace, ind_levels,
+*** 2505,2510 ****
+  	  if (reg_equiv_constant[regno] != 0
+  	      && (set == 0 || &SET_DEST (set) != recog_operand_loc[i]))
+! 	    substed_operand[i] = recog_operand[i]
+! 	      = reg_equiv_constant[regno];
+  #if 0 /* This might screw code in reload1.c to delete prior output-reload
+  	 that feeds this insn.  */
+--- 2549,2557 ----
+  	  if (reg_equiv_constant[regno] != 0
+  	      && (set == 0 || &SET_DEST (set) != recog_operand_loc[i]))
+! 	    {
+! 	      substed_operand[i] = recog_operand[i]
+! 		= reg_equiv_constant[regno];
+! 	      force_update[i] = 1;
+! 	    }
+  #if 0 /* This might screw code in reload1.c to delete prior output-reload
+  	 that feeds this insn.  */
+*************** find_reloads (insn, replace, ind_levels,
+*** 2545,2549 ****
+  				    XEXP (recog_operand[i], 0),
+  				    &XEXP (recog_operand[i], 0),
+! 				    i, address_type[i], ind_levels);
+  	      substed_operand[i] = recog_operand[i] = *recog_operand_loc[i];
+  	    }
+--- 2592,2597 ----
+  				    XEXP (recog_operand[i], 0),
+  				    &XEXP (recog_operand[i], 0),
+! 				    i, address_type[i], ind_levels,
+! 				    &force_update[i]);
+  	      substed_operand[i] = recog_operand[i] = *recog_operand_loc[i];
+  	    }
+*************** find_reloads (insn, replace, ind_levels,
+*** 3415,3419 ****
+  	  = find_reloads_toplev (force_const_mem (operand_mode[i],
+  						  recog_operand[i]),
+! 				 i, address_type[i], ind_levels, 0);
+  	if (alternative_allows_memconst (constraints1[i],
+  					 goal_alternative_number))
+--- 3463,3467 ----
+  	  = find_reloads_toplev (force_const_mem (operand_mode[i],
+  						  recog_operand[i]),
+! 				 i, address_type[i], ind_levels, 0, NULL);
+  	if (alternative_allows_memconst (constraints1[i],
+  					 goal_alternative_number))
+*************** find_reloads (insn, replace, ind_levels,
+*** 3595,3609 ****
+       Don't do this if we aren't making replacements because we might be
+       propagating things allocated by frame pointer elimination into places
+!      it doesn't expect.  */
+  
+!   if (insn_code_number >= 0 && replace)
+!     for (i = insn_n_dups[insn_code_number] - 1; i >= 0; i--)
+!       {
+! 	int opno = recog_dup_num[i];
+! 	*recog_dup_loc[i] = *recog_operand_loc[opno];
+! 	if (operand_reloadnum[opno] >= 0)
+! 	  push_replacement (recog_dup_loc[i], operand_reloadnum[opno],
+! 			    insn_operand_mode[insn_code_number][opno]);
+!       }
+  
+  #if 0
+--- 3643,3664 ----
+       Don't do this if we aren't making replacements because we might be
+       propagating things allocated by frame pointer elimination into places
+!      it doesn't expect.  However, always do it for replaces of pseudos
+!      by constants.  */
+  
+!   for (i = insn_n_dups[insn_code_number] - 1; i >= 0; i--)
+!     {
+!       int opno = recog_dup_num[i];
+! 
+!       if (! (insn_code_number >= 0 && replace))
+! 	{
+! 	  if (! force_update[opno])
+! 	    continue;
+! 	}
+! 
+!       *recog_dup_loc[i] = *recog_operand_loc[opno];
+!       if (operand_reloadnum[opno] >= 0)
+! 	push_replacement (recog_dup_loc[i], operand_reloadnum[opno],
+! 			  insn_operand_mode[insn_code_number][opno]);
+!     }
+  
+  #if 0
+*************** find_reloads (insn, replace, ind_levels,
+*** 3829,3832 ****
+--- 3884,3888 ----
+        register RTX_CODE code = GET_CODE (recog_operand[i]);
+        int is_set_dest = GET_CODE (body) == SET && (i == 0);
++       short ign;
+  
+        if (insn_code_number >= 0)
+*************** find_reloads (insn, replace, ind_levels,
+*** 3834,3838 ****
+  	  find_reloads_address (VOIDmode, NULL_PTR,
+  				recog_operand[i], recog_operand_loc[i],
+! 				i, RELOAD_FOR_INPUT, ind_levels);
+  
+        /* In these cases, we can't tell if the operand is an input
+--- 3890,3894 ----
+  	  find_reloads_address (VOIDmode, NULL_PTR,
+  				recog_operand[i], recog_operand_loc[i],
+! 				i, RELOAD_FOR_INPUT, ind_levels, &ign);
+  
+        /* In these cases, we can't tell if the operand is an input
+*************** find_reloads (insn, replace, ind_levels,
+*** 3845,3853 ****
+  			      XEXP (recog_operand[i], 0),
+  			      &XEXP (recog_operand[i], 0),
+! 			      i, RELOAD_OTHER, ind_levels);
+        if (code == SUBREG)
+  	recog_operand[i] = *recog_operand_loc[i]
+  	  = find_reloads_toplev (recog_operand[i], i, RELOAD_OTHER,
+! 				 ind_levels, is_set_dest);
+        if (code == REG)
+  	{
+--- 3901,3909 ----
+  			      XEXP (recog_operand[i], 0),
+  			      &XEXP (recog_operand[i], 0),
+! 			      i, RELOAD_OTHER, ind_levels, &ign);
+        if (code == SUBREG)
+  	recog_operand[i] = *recog_operand_loc[i]
+  	  = find_reloads_toplev (recog_operand[i], i, RELOAD_OTHER,
+! 				 ind_levels, is_set_dest, &ign);
+        if (code == REG)
+  	{
+*************** alternative_allows_memconst (constraint,
+*** 3908,3915 ****
+  
+     IS_SET_DEST is true if X is the destination of a SET, which is not
+!    appropriate to be replaced by a constant.  */
+  
+  static rtx
+! find_reloads_toplev (x, opnum, type, ind_levels, is_set_dest)
+       rtx x;
+       int opnum;
+--- 3964,3974 ----
+  
+     IS_SET_DEST is true if X is the destination of a SET, which is not
+!    appropriate to be replaced by a constant.
+! 
+!    FORCE_UPDATE, if non-NULL, is the address of a SHORT that is set to
+!    1 if X is replaced with something based on reg_equiv_constant.  */
+  
+  static rtx
+! find_reloads_toplev (x, opnum, type, ind_levels, is_set_dest, force_update)
+       rtx x;
+       int opnum;
+*************** find_reloads_toplev (x, opnum, type, ind
+*** 3917,3920 ****
+--- 3976,3980 ----
+       int ind_levels;
+       int is_set_dest;
++      short *force_update;
+  {
+    register RTX_CODE code = GET_CODE (x);
+*************** find_reloads_toplev (x, opnum, type, ind
+*** 3928,3932 ****
+        register int regno = REGNO (x);
+        if (reg_equiv_constant[regno] != 0 && !is_set_dest)
+! 	x = reg_equiv_constant[regno];
+  #if 0
+  /*  This creates (subreg (mem...)) which would cause an unnecessary
+--- 3988,3998 ----
+        register int regno = REGNO (x);
+        if (reg_equiv_constant[regno] != 0 && !is_set_dest)
+! 	{
+! 	  x = reg_equiv_constant[regno];
+! 	  if (force_update)
+! 	    *force_update = 1;
+! 	  else
+! 	    abort ();	/* Learn why this happens. */
+! 	}
+  #if 0
+  /*  This creates (subreg (mem...)) which would cause an unnecessary
+*************** find_reloads_toplev (x, opnum, type, ind
+*** 3951,3955 ****
+  	  find_reloads_address (GET_MODE (x), NULL_PTR,
+  				XEXP (x, 0),
+! 				&XEXP (x, 0), opnum, type, ind_levels);
+  	}
+        return x;
+--- 4017,4022 ----
+  	  find_reloads_address (GET_MODE (x), NULL_PTR,
+  				XEXP (x, 0),
+! 				&XEXP (x, 0), opnum, type, ind_levels,
+! 				force_update);
+  	}
+        return x;
+*************** find_reloads_toplev (x, opnum, type, ind
+*** 3959,3963 ****
+        rtx tem = x;
+        find_reloads_address (GET_MODE (x), &tem, XEXP (x, 0), &XEXP (x, 0),
+! 			    opnum, type, ind_levels);
+        return tem;
+      }
+--- 4026,4030 ----
+        rtx tem = x;
+        find_reloads_address (GET_MODE (x), &tem, XEXP (x, 0), &XEXP (x, 0),
+! 			    opnum, type, ind_levels, force_update);
+        return tem;
+      }
+*************** find_reloads_toplev (x, opnum, type, ind
+*** 3982,3986 ****
+  	  && (tem = gen_lowpart_common (GET_MODE (x),
+  					reg_equiv_constant[regno])) != 0)
+! 	return tem;
+  
+        if (GET_MODE_BITSIZE (GET_MODE (x)) == BITS_PER_WORD
+--- 4049,4059 ----
+  	  && (tem = gen_lowpart_common (GET_MODE (x),
+  					reg_equiv_constant[regno])) != 0)
+! 	{
+! 	  if (force_update)
+! 	    *force_update = 1;
+! 	  else
+! 	    abort ();	/* Learn why this happens. */
+! 	  return tem;
+! 	}
+  
+        if (GET_MODE_BITSIZE (GET_MODE (x)) == BITS_PER_WORD
+*************** find_reloads_toplev (x, opnum, type, ind
+*** 3990,3994 ****
+  				     SUBREG_WORD (x), 0,
+  				     GET_MODE (SUBREG_REG (x)))) != 0)
+! 	return tem;
+  
+        if (regno >= FIRST_PSEUDO_REGISTER && reg_renumber[regno] < 0
+--- 4063,4073 ----
+  				     SUBREG_WORD (x), 0,
+  				     GET_MODE (SUBREG_REG (x)))) != 0)
+! 	{
+! 	  if (force_update)
+! 	    *force_update = 1;
+! 	  else
+! 	    abort ();	/* Learn why this happens. */
+! 	  return tem;
+! 	}
+  
+        if (regno >= FIRST_PSEUDO_REGISTER && reg_renumber[regno] < 0
+*************** find_reloads_toplev (x, opnum, type, ind
+*** 4040,4044 ****
+  	  find_reloads_address (GET_MODE (x), NULL_PTR,
+  				XEXP (x, 0),
+! 				&XEXP (x, 0), opnum, type, ind_levels);
+  	}
+  
+--- 4119,4124 ----
+  	  find_reloads_address (GET_MODE (x), NULL_PTR,
+  				XEXP (x, 0),
+! 				&XEXP (x, 0), opnum, type, ind_levels,
+! 				force_update);
+  	}
+  
+*************** find_reloads_toplev (x, opnum, type, ind
+*** 4049,4053 ****
+        if (fmt[i] == 'e')
+  	XEXP (x, i) = find_reloads_toplev (XEXP (x, i), opnum, type,
+! 					   ind_levels, is_set_dest);
+      }
+    return x;
+--- 4129,4133 ----
+        if (fmt[i] == 'e')
+  	XEXP (x, i) = find_reloads_toplev (XEXP (x, i), opnum, type,
+! 					   ind_levels, is_set_dest, NULL);
+      }
+    return x;
+*************** make_memloc (ad, regno)
+*** 4110,4114 ****
+  
+  static int
+! find_reloads_address (mode, memrefloc, ad, loc, opnum, type, ind_levels)
+       enum machine_mode mode;
+       rtx *memrefloc;
+--- 4190,4195 ----
+  
+  static int
+! find_reloads_address (mode, memrefloc, ad, loc, opnum, type, ind_levels,
+! 		      force_update)
+       enum machine_mode mode;
+       rtx *memrefloc;
+*************** find_reloads_address (mode, memrefloc, a
+*** 4118,4121 ****
+--- 4199,4203 ----
+       enum reload_type type;
+       int ind_levels;
++      short *force_update;
+  {
+    register int regno;
+*************** find_reloads_address (mode, memrefloc, a
+*** 4134,4137 ****
+--- 4216,4223 ----
+  	{
+  	  *loc = ad = reg_equiv_constant[regno];
++ 	  if (force_update)
++ 	    *force_update = 1;
++ 	  else
++ 	    abort ();	/* Learn why this happens. */
+  	  return 1;
+  	}
+*************** find_reloads_address (mode, memrefloc, a
+*** 4141,4145 ****
+  	  tem = make_memloc (ad, regno);
+  	  find_reloads_address (GET_MODE (tem), NULL_PTR, XEXP (tem, 0),
+! 				&XEXP (tem, 0), opnum, type, ind_levels);
+  	  push_reload (tem, NULL_RTX, loc, NULL_PTR, BASE_REG_CLASS,
+  		       GET_MODE (ad), VOIDmode, 0, 0,
+--- 4227,4231 ----
+  	  tem = make_memloc (ad, regno);
+  	  find_reloads_address (GET_MODE (tem), NULL_PTR, XEXP (tem, 0),
+! 				&XEXP (tem, 0), opnum, type, ind_levels, NULL);
+  	  push_reload (tem, NULL_RTX, loc, NULL_PTR, BASE_REG_CLASS,
+  		       GET_MODE (ad), VOIDmode, 0, 0,
+*************** find_reloads_address (mode, memrefloc, a
+*** 4214,4218 ****
+        tem = ad;
+        find_reloads_address (GET_MODE (ad), &tem, XEXP (ad, 0), &XEXP (ad, 0),
+! 			    opnum, type, ind_levels == 0 ? 0 : ind_levels - 1);
+  
+        /* If tem was changed, then we must create a new memory reference to
+--- 4300,4305 ----
+        tem = ad;
+        find_reloads_address (GET_MODE (ad), &tem, XEXP (ad, 0), &XEXP (ad, 0),
+! 			    opnum, type, ind_levels == 0 ? 0 : ind_levels - 1,
+! 			    NULL);
+  
+        /* If tem was changed, then we must create a new memory reference to
+*************** find_reloads_address_1 (x, context, loc,
+*** 4722,4726 ****
+  	      /* First reload the memory location's address.  */
+  	      find_reloads_address (GET_MODE (tem), 0, XEXP (tem, 0),
+! 				    &XEXP (tem, 0), opnum, type, ind_levels);
+  	      /* Put this inside a new increment-expression.  */
+  	      x = gen_rtx (GET_CODE (x), GET_MODE (x), tem);
+--- 4809,4814 ----
+  	      /* First reload the memory location's address.  */
+  	      find_reloads_address (GET_MODE (tem), 0, XEXP (tem, 0),
+! 				    &XEXP (tem, 0), opnum, type, ind_levels,
+! 				    NULL);
+  	      /* Put this inside a new increment-expression.  */
+  	      x = gen_rtx (GET_CODE (x), GET_MODE (x), tem);
+*************** find_reloads_address_1 (x, context, loc,
+*** 4788,4792 ****
+  	  find_reloads_address (GET_MODE (x), &XEXP (x, 0),
+  				XEXP (XEXP (x, 0), 0), &XEXP (XEXP (x, 0), 0),
+! 				opnum, type, ind_levels);
+  
+  	  reloadnum = push_reload (x, NULL_RTX, loc, NULL_PTR,
+--- 4876,4880 ----
+  	  find_reloads_address (GET_MODE (x), &XEXP (x, 0),
+  				XEXP (XEXP (x, 0), 0), &XEXP (XEXP (x, 0), 0),
+! 				opnum, type, ind_levels, NULL);
+  
+  	  reloadnum = push_reload (x, NULL_RTX, loc, NULL_PTR,
+*************** find_reloads_address_1 (x, context, loc,
+*** 4818,4822 ****
+  
+        find_reloads_address (GET_MODE (x), loc, XEXP (x, 0), &XEXP (x, 0),
+! 			    opnum, type, ind_levels);
+        push_reload (*loc, NULL_RTX, loc, NULL_PTR,
+  		   context ? INDEX_REG_CLASS : BASE_REG_CLASS,
+--- 4906,4910 ----
+  
+        find_reloads_address (GET_MODE (x), loc, XEXP (x, 0), &XEXP (x, 0),
+! 			    opnum, type, ind_levels, NULL);
+        push_reload (*loc, NULL_RTX, loc, NULL_PTR,
+  		   context ? INDEX_REG_CLASS : BASE_REG_CLASS,
+*************** find_reloads_address_1 (x, context, loc,
+*** 4852,4856 ****
+  	    x = make_memloc (x, regno);
+  	    find_reloads_address (GET_MODE (x), 0, XEXP (x, 0), &XEXP (x, 0),
+! 				  opnum, type, ind_levels);
+  	  }
+  
+--- 4940,4944 ----
+  	    x = make_memloc (x, regno);
+  	    find_reloads_address (GET_MODE (x), 0, XEXP (x, 0), &XEXP (x, 0),
+! 				  opnum, type, ind_levels, NULL);
+  	  }
+  
+*************** find_reloads_address_part (x, loc, class
+*** 4965,4969 ****
+        rtx tem = x = force_const_mem (mode, x);
+        find_reloads_address (mode, &tem, XEXP (tem, 0), &XEXP (tem, 0),
+! 			    opnum, type, ind_levels);
+      }
+  
+--- 5053,5057 ----
+        rtx tem = x = force_const_mem (mode, x);
+        find_reloads_address (mode, &tem, XEXP (tem, 0), &XEXP (tem, 0),
+! 			    opnum, type, ind_levels, NULL);
+      }
+  
+*************** find_reloads_address_part (x, loc, class
+*** 4977,4981 ****
+        x = gen_rtx (PLUS, GET_MODE (x), XEXP (x, 0), tem);
+        find_reloads_address (mode, &tem, XEXP (tem, 0), &XEXP (tem, 0),
+! 			    opnum, type, ind_levels);
+      }
+  
+--- 5065,5069 ----
+        x = gen_rtx (PLUS, GET_MODE (x), XEXP (x, 0), tem);
+        find_reloads_address (mode, &tem, XEXP (tem, 0), &XEXP (tem, 0),
+! 			    opnum, type, ind_levels, NULL);
+      }
+  
+*************** find_equiv_reg (goal, insn, class, other
+*** 5518,5522 ****
+       and is also a register that appears in the address of GOAL.  */
+  
+!   if (goal_mem && value == SET_DEST (PATTERN (where))
+        && refers_to_regno_for_reload_p (valueno,
+  				       (valueno
+--- 5606,5610 ----
+       and is also a register that appears in the address of GOAL.  */
+  
+!   if (goal_mem && value == SET_DEST (single_set (where))
+        && refers_to_regno_for_reload_p (valueno,
+  				       (valueno
+*************** debug_reload()
+*** 5900,5904 ****
+  
+        if (reload_nocombine[r])
+! 	fprintf (stderr, ", can combine", reload_nocombine[r]);
+  
+        if (reload_secondary_p[r])
+--- 5988,5992 ----
+  
+        if (reload_nocombine[r])
+! 	fprintf (stderr, ", can't combine %d", reload_nocombine[r]);
+  
+        if (reload_secondary_p[r])
+diff -rcp2N gcc-2.7.2.2/reload1.c g77-new/reload1.c
+*** gcc-2.7.2.2/reload1.c	Sun Nov  5 11:22:22 1995
+--- g77-new/reload1.c	Sun Aug 10 18:47:00 1997
+*************** reload (first, global, dumpfile)
+*** 542,546 ****
+       Also find all paradoxical subregs and find largest such for each pseudo.
+       On machines with small register classes, record hard registers that
+!      are used for user variables.  These can never be used for spills.  */
+  
+    for (insn = first; insn; insn = NEXT_INSN (insn))
+--- 542,548 ----
+       Also find all paradoxical subregs and find largest such for each pseudo.
+       On machines with small register classes, record hard registers that
+!      are used for user variables.  These can never be used for spills. 
+!      Also look for a "constant" NOTE_INSN_SETJMP.  This means that all
+!      caller-saved registers must be marked live.  */
+  
+    for (insn = first; insn; insn = NEXT_INSN (insn))
+*************** reload (first, global, dumpfile)
+*** 548,551 ****
+--- 550,559 ----
+        rtx set = single_set (insn);
+  
++       if (GET_CODE (insn) == NOTE && CONST_CALL_P (insn)
++ 	  && NOTE_LINE_NUMBER (insn) == NOTE_INSN_SETJMP)
++ 	for (i = 0; i < FIRST_PSEUDO_REGISTER; i++)
++ 	  if (! call_used_regs[i])
++ 	    regs_ever_live[i] = 1;
++ 
+        if (set != 0 && GET_CODE (SET_DEST (set)) == REG)
+  	{
+*************** reload (first, global, dumpfile)
+*** 564,568 ****
+  		  if (GET_CODE (x) == MEM)
+  		    reg_equiv_memory_loc[i] = x;
+! 		  else if (CONSTANT_P (x))
+  		    {
+  		      if (LEGITIMATE_CONSTANT_P (x))
+--- 572,578 ----
+  		  if (GET_CODE (x) == MEM)
+  		    reg_equiv_memory_loc[i] = x;
+! 		  else if (CONSTANT_P (x)
+! 			   && ! (GET_CODE (x) == CONST
+! 				 && GET_CODE (XEXP (x, 0)) == MINUS))
+  		    {
+  		      if (LEGITIMATE_CONSTANT_P (x))
+*************** eliminate_regs (x, mem_mode, insn)
+*** 2886,2890 ****
+  
+        /* Fall through to generic unary operation case.  */
+-     case USE:
+      case STRICT_LOW_PART:
+      case NEG:          case NOT:
+--- 2896,2899 ----
+*************** eliminate_regs (x, mem_mode, insn)
+*** 2975,2978 ****
+--- 2984,3000 ----
+        return x;
+  
++     case USE:
++       /* If using a register that is the source of an eliminate we still
++ 	 think can be performed, note it cannot be performed since we don't
++ 	 know how this register is used.  */
++       for (ep = reg_eliminate; ep < &reg_eliminate[NUM_ELIMINABLE_REGS]; ep++)
++ 	if (ep->from_rtx == XEXP (x, 0))
++ 	  ep->can_eliminate = 0;
++ 
++       new = eliminate_regs (XEXP (x, 0), mem_mode, insn);
++       if (new != XEXP (x, 0))
++ 	return gen_rtx (code, GET_MODE (x), new);
++       return x;
++ 
+      case CLOBBER:
+        /* If clobbering a register that is the replacement register for an
+*************** gen_reload (out, in, opnum, type)
+*** 6736,6741 ****
+--- 6758,6765 ----
+    if (GET_CODE (in) == PLUS
+        && (GET_CODE (XEXP (in, 0)) == REG
++ 	  || GET_CODE (XEXP (in, 0)) == SUBREG
+  	  || GET_CODE (XEXP (in, 0)) == MEM)
+        && (GET_CODE (XEXP (in, 1)) == REG
++ 	  || GET_CODE (XEXP (in, 1)) == SUBREG
+  	  || CONSTANT_P (XEXP (in, 1))
+  	  || GET_CODE (XEXP (in, 1)) == MEM))
+*************** gen_reload (out, in, opnum, type)
+*** 6798,6807 ****
+  	 we emit below.  */
+  
+!       if (CONSTANT_P (op1) || GET_CODE (op1) == MEM
+  	  || (GET_CODE (op1) == REG
+  	      && REGNO (op1) >= FIRST_PSEUDO_REGISTER))
+  	tem = op0, op0 = op1, op1 = tem;
+  
+!       emit_insn (gen_move_insn (out, op0));
+  
+        /* If OP0 and OP1 are the same, we can use OUT for OP1.
+--- 6822,6831 ----
+  	 we emit below.  */
+  
+!       if (CONSTANT_P (op1) || GET_CODE (op1) == MEM || GET_CODE (op1) == SUBREG
+  	  || (GET_CODE (op1) == REG
+  	      && REGNO (op1) >= FIRST_PSEUDO_REGISTER))
+  	tem = op0, op0 = op1, op1 = tem;
+  
+!       gen_reload (out, op0, opnum, type);
+  
+        /* If OP0 and OP1 are the same, we can use OUT for OP1.
+*************** gen_reload (out, in, opnum, type)
+*** 6831,6835 ****
+        delete_insns_since (last);
+  
+!       emit_insn (gen_move_insn (out, op1));
+        emit_insn (gen_add2_insn (out, op0));
+      }
+--- 6855,6859 ----
+        delete_insns_since (last);
+  
+!       gen_reload (out, op1, opnum, type);
+        emit_insn (gen_add2_insn (out, op0));
+      }
+*************** gen_reload (out, in, opnum, type)
+*** 6852,6857 ****
+  	in = gen_rtx (REG, GET_MODE (loc), REGNO (in));
+  
+!       emit_insn (gen_move_insn (loc, in));
+!       emit_insn (gen_move_insn (out, loc));
+      }
+  #endif
+--- 6876,6881 ----
+  	in = gen_rtx (REG, GET_MODE (loc), REGNO (in));
+  
+!       gen_reload (loc, in, opnum, type);
+!       gen_reload (out, loc, opnum, type);
+      }
+  #endif
+diff -rcp2N gcc-2.7.2.2/rtl.c g77-new/rtl.c
+*** gcc-2.7.2.2/rtl.c	Thu Jun 15 08:02:59 1995
+--- g77-new/rtl.c	Thu Jul 10 20:09:06 1997
+*************** char *reg_note_name[] = { "", "REG_DEAD"
+*** 179,183 ****
+  			  "REG_NONNEG", "REG_NO_CONFLICT", "REG_UNUSED",
+  			  "REG_CC_SETTER", "REG_CC_USER", "REG_LABEL",
+! 			  "REG_DEP_ANTI", "REG_DEP_OUTPUT" };
+  
+  /* Allocate an rtx vector of N elements.
+--- 179,183 ----
+  			  "REG_NONNEG", "REG_NO_CONFLICT", "REG_UNUSED",
+  			  "REG_CC_SETTER", "REG_CC_USER", "REG_LABEL",
+! 			  "REG_DEP_ANTI", "REG_DEP_OUTPUT", "REG_NOALIAS" };
+  
+  /* Allocate an rtx vector of N elements.
+diff -rcp2N gcc-2.7.2.2/rtl.h g77-new/rtl.h
+*** gcc-2.7.2.2/rtl.h	Thu Jun 15 08:03:16 1995
+--- g77-new/rtl.h	Thu Jul 10 20:09:07 1997
+*************** enum reg_note { REG_DEAD = 1, REG_INC = 
+*** 349,353 ****
+  		REG_NONNEG = 8, REG_NO_CONFLICT = 9, REG_UNUSED = 10,
+  		REG_CC_SETTER = 11, REG_CC_USER = 12, REG_LABEL = 13,
+! 		REG_DEP_ANTI = 14, REG_DEP_OUTPUT = 15 };
+  
+  /* Define macros to extract and insert the reg-note kind in an EXPR_LIST.  */
+--- 349,353 ----
+  		REG_NONNEG = 8, REG_NO_CONFLICT = 9, REG_UNUSED = 10,
+  		REG_CC_SETTER = 11, REG_CC_USER = 12, REG_LABEL = 13,
+! 		REG_DEP_ANTI = 14, REG_DEP_OUTPUT = 15, REG_NOALIAS = 16 };
+  
+  /* Define macros to extract and insert the reg-note kind in an EXPR_LIST.  */
+*************** extern char *reg_note_name[];
+*** 432,436 ****
+  #define NOTE_INSN_FUNCTION_BEG -13
+  
+- 
+  #if 0 /* These are not used, and I don't know what they were for. --rms.  */
+  #define NOTE_DECL_NAME(INSN) ((INSN)->fld[3].rtstr)
+--- 432,435 ----
+*************** extern char *note_insn_name[];
+*** 576,579 ****
+--- 575,579 ----
+  /* For a TRAP_IF rtx, TRAP_CONDITION is an expression.  */
+  #define TRAP_CONDITION(RTX) ((RTX)->fld[0].rtx)
++ #define TRAP_CODE(RTX) ((RTX)->fld[1].rtint)
+  
+  /* 1 in a SYMBOL_REF if it addresses this function's constants pool.  */
+*************** extern rtx eliminate_constant_term	PROTO
+*** 817,820 ****
+--- 817,830 ----
+  extern rtx expand_complex_abs		PROTO((enum machine_mode, rtx, rtx, int));
+  extern enum machine_mode choose_hard_reg_mode PROTO((int, int));
++ extern int rtx_varies_p		PROTO((rtx));
++ extern int may_trap_p		PROTO((rtx));
++ extern int side_effects_p	PROTO((rtx));
++ extern int volatile_refs_p	PROTO((rtx));
++ extern int volatile_insn_p	PROTO((rtx));
++ extern void remove_note		PROTO((rtx, rtx));
++ extern void note_stores		PROTO((rtx, void (*)()));
++ extern int refers_to_regno_p	PROTO((int, int, rtx, rtx *));
++ extern int reg_overlap_mentioned_p PROTO((rtx, rtx));
++ 
+  
+  /* Maximum number of parallel sets and clobbers in any insn in this fn.
+*************** extern rtx *regno_reg_rtx;
+*** 967,968 ****
+--- 977,987 ----
+  
+  extern int rtx_to_tree_code	PROTO((enum rtx_code));
++ 
++ extern int true_dependence	PROTO((rtx, enum machine_mode, rtx, int (*)()));
++ extern int read_dependence	PROTO((rtx, rtx));
++ extern int anti_dependence	PROTO((rtx, rtx));
++ extern int output_dependence	PROTO((rtx, rtx));
++ extern void init_alias_analysis	PROTO((void));
++ extern void end_alias_analysis	PROTO((void));
++ extern void mark_user_reg	PROTO((rtx));
++ extern void mark_reg_pointer	PROTO((rtx));
+diff -rcp2N gcc-2.7.2.2/sched.c g77-new/sched.c
+*** gcc-2.7.2.2/sched.c	Thu Jun 15 08:06:39 1995
+--- g77-new/sched.c	Sun Aug 10 18:46:13 1997
+*************** Boston, MA 02111-1307, USA.  */
+*** 126,129 ****
+--- 126,132 ----
+  #include "insn-attr.h"
+  
++ extern char *reg_known_equiv_p;
++ extern rtx *reg_known_value;
++ 
+  #ifdef INSN_SCHEDULING
+  /* Arrays set up by scheduling for the same respective purposes as
+*************** static int *sched_reg_live_length;
+*** 143,146 ****
+--- 146,150 ----
+     by splitting insns.  */
+  static rtx *reg_last_uses;
++ static int reg_last_uses_size;
+  static rtx *reg_last_sets;
+  static regset reg_pending_sets;
+*************** struct sometimes
+*** 294,302 ****
+  
+  /* Forward declarations.  */
+- static rtx canon_rtx			PROTO((rtx));
+- static int rtx_equal_for_memref_p	PROTO((rtx, rtx));
+- static rtx find_symbolic_term		PROTO((rtx));
+- static int memrefs_conflict_p		PROTO((int, rtx, int, rtx,
+- 					       HOST_WIDE_INT));
+  static void add_dependence		PROTO((rtx, rtx, enum reg_note));
+  static void remove_dependence		PROTO((rtx, rtx));
+--- 298,301 ----
+*************** static int priority			PROTO((rtx));
+*** 314,318 ****
+  static void free_pending_lists		PROTO((void));
+  static void add_insn_mem_dependence	PROTO((rtx *, rtx *, rtx, rtx));
+! static void flush_pending_lists		PROTO((rtx));
+  static void sched_analyze_1		PROTO((rtx, rtx));
+  static void sched_analyze_2		PROTO((rtx, rtx));
+--- 313,317 ----
+  static void free_pending_lists		PROTO((void));
+  static void add_insn_mem_dependence	PROTO((rtx *, rtx *, rtx, rtx));
+! static void flush_pending_lists		PROTO((rtx, int));
+  static void sched_analyze_1		PROTO((rtx, rtx));
+  static void sched_analyze_2		PROTO((rtx, rtx));
+*************** void schedule_insns	PROTO((FILE *));
+*** 346,885 ****
+  #endif /* INSN_SCHEDULING */
+  
+- #define SIZE_FOR_MODE(X) (GET_MODE_SIZE (GET_MODE (X)))
+- 
+- /* Vector indexed by N giving the initial (unchanging) value known
+-    for pseudo-register N.  */
+- static rtx *reg_known_value;
+- 
+- /* Vector recording for each reg_known_value whether it is due to a
+-    REG_EQUIV note.  Future passes (viz., reload) may replace the
+-    pseudo with the equivalent expression and so we account for the
+-    dependences that would be introduced if that happens. */
+- /* ??? This is a problem only on the Convex.  The REG_EQUIV notes created in
+-    assign_parms mention the arg pointer, and there are explicit insns in the
+-    RTL that modify the arg pointer.  Thus we must ensure that such insns don't
+-    get scheduled across each other because that would invalidate the REG_EQUIV
+-    notes.  One could argue that the REG_EQUIV notes are wrong, but solving
+-    the problem in the scheduler will likely give better code, so we do it
+-    here.  */
+- static char *reg_known_equiv_p;
+- 
+- /* Indicates number of valid entries in reg_known_value.  */
+- static int reg_known_value_size;
+- 
+- static rtx
+- canon_rtx (x)
+-      rtx x;
+- {
+-   if (GET_CODE (x) == REG && REGNO (x) >= FIRST_PSEUDO_REGISTER
+-       && REGNO (x) <= reg_known_value_size)
+-     return reg_known_value[REGNO (x)];
+-   else if (GET_CODE (x) == PLUS)
+-     {
+-       rtx x0 = canon_rtx (XEXP (x, 0));
+-       rtx x1 = canon_rtx (XEXP (x, 1));
+- 
+-       if (x0 != XEXP (x, 0) || x1 != XEXP (x, 1))
+- 	{
+- 	  /* We can tolerate LO_SUMs being offset here; these
+- 	     rtl are used for nothing other than comparisons.  */
+- 	  if (GET_CODE (x0) == CONST_INT)
+- 	    return plus_constant_for_output (x1, INTVAL (x0));
+- 	  else if (GET_CODE (x1) == CONST_INT)
+- 	    return plus_constant_for_output (x0, INTVAL (x1));
+- 	  return gen_rtx (PLUS, GET_MODE (x), x0, x1);
+- 	}
+-     }
+-   return x;
+- }
+- 
+- /* Set up all info needed to perform alias analysis on memory references.  */
+- 
+- void
+- init_alias_analysis ()
+- {
+-   int maxreg = max_reg_num ();
+-   rtx insn;
+-   rtx note;
+-   rtx set;
+- 
+-   reg_known_value_size = maxreg;
+- 
+-   reg_known_value
+-     = (rtx *) oballoc ((maxreg-FIRST_PSEUDO_REGISTER) * sizeof (rtx))
+-       - FIRST_PSEUDO_REGISTER;
+-   bzero ((char *) (reg_known_value + FIRST_PSEUDO_REGISTER),
+- 	 (maxreg-FIRST_PSEUDO_REGISTER) * sizeof (rtx));
+- 
+-   reg_known_equiv_p
+-     = (char *) oballoc ((maxreg -FIRST_PSEUDO_REGISTER) * sizeof (char))
+-       - FIRST_PSEUDO_REGISTER;
+-   bzero (reg_known_equiv_p + FIRST_PSEUDO_REGISTER,
+- 	 (maxreg - FIRST_PSEUDO_REGISTER) * sizeof (char));
+- 
+-   /* Fill in the entries with known constant values.  */
+-   for (insn = get_insns (); insn; insn = NEXT_INSN (insn))
+-     if ((set = single_set (insn)) != 0
+- 	&& GET_CODE (SET_DEST (set)) == REG
+- 	&& REGNO (SET_DEST (set)) >= FIRST_PSEUDO_REGISTER
+- 	&& (((note = find_reg_note (insn, REG_EQUAL, 0)) != 0
+- 	     && reg_n_sets[REGNO (SET_DEST (set))] == 1)
+- 	    || (note = find_reg_note (insn, REG_EQUIV, NULL_RTX)) != 0)
+- 	&& GET_CODE (XEXP (note, 0)) != EXPR_LIST)
+-       {
+- 	int regno = REGNO (SET_DEST (set));
+- 	reg_known_value[regno] = XEXP (note, 0);
+- 	reg_known_equiv_p[regno] = REG_NOTE_KIND (note) == REG_EQUIV;
+-       }
+- 
+-   /* Fill in the remaining entries.  */
+-   while (--maxreg >= FIRST_PSEUDO_REGISTER)
+-     if (reg_known_value[maxreg] == 0)
+-       reg_known_value[maxreg] = regno_reg_rtx[maxreg];
+- }
+- 
+- /* Return 1 if X and Y are identical-looking rtx's.
+- 
+-    We use the data in reg_known_value above to see if two registers with
+-    different numbers are, in fact, equivalent.  */
+- 
+- static int
+- rtx_equal_for_memref_p (x, y)
+-      rtx x, y;
+- {
+-   register int i;
+-   register int j;
+-   register enum rtx_code code;
+-   register char *fmt;
+- 
+-   if (x == 0 && y == 0)
+-     return 1;
+-   if (x == 0 || y == 0)
+-     return 0;
+-   x = canon_rtx (x);
+-   y = canon_rtx (y);
+- 
+-   if (x == y)
+-     return 1;
+- 
+-   code = GET_CODE (x);
+-   /* Rtx's of different codes cannot be equal.  */
+-   if (code != GET_CODE (y))
+-     return 0;
+- 
+-   /* (MULT:SI x y) and (MULT:HI x y) are NOT equivalent.
+-      (REG:SI x) and (REG:HI x) are NOT equivalent.  */
+- 
+-   if (GET_MODE (x) != GET_MODE (y))
+-     return 0;
+- 
+-   /* REG, LABEL_REF, and SYMBOL_REF can be compared nonrecursively.  */
+- 
+-   if (code == REG)
+-     return REGNO (x) == REGNO (y);
+-   if (code == LABEL_REF)
+-     return XEXP (x, 0) == XEXP (y, 0);
+-   if (code == SYMBOL_REF)
+-     return XSTR (x, 0) == XSTR (y, 0);
+- 
+-   /* For commutative operations, the RTX match if the operand match in any
+-      order.  Also handle the simple binary and unary cases without a loop.  */
+-   if (code == EQ || code == NE || GET_RTX_CLASS (code) == 'c')
+-     return ((rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0))
+- 	     && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 1)))
+- 	    || (rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 1))
+- 		&& rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 0))));
+-   else if (GET_RTX_CLASS (code) == '<' || GET_RTX_CLASS (code) == '2')
+-     return (rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0))
+- 	    && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 1)));
+-   else if (GET_RTX_CLASS (code) == '1')
+-     return rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0));
+- 
+-   /* Compare the elements.  If any pair of corresponding elements
+-      fail to match, return 0 for the whole things.  */
+- 
+-   fmt = GET_RTX_FORMAT (code);
+-   for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--)
+-     {
+-       switch (fmt[i])
+- 	{
+- 	case 'w':
+- 	  if (XWINT (x, i) != XWINT (y, i))
+- 	    return 0;
+- 	  break;
+- 
+- 	case 'n':
+- 	case 'i':
+- 	  if (XINT (x, i) != XINT (y, i))
+- 	    return 0;
+- 	  break;
+- 
+- 	case 'V':
+- 	case 'E':
+- 	  /* Two vectors must have the same length.  */
+- 	  if (XVECLEN (x, i) != XVECLEN (y, i))
+- 	    return 0;
+- 
+- 	  /* And the corresponding elements must match.  */
+- 	  for (j = 0; j < XVECLEN (x, i); j++)
+- 	    if (rtx_equal_for_memref_p (XVECEXP (x, i, j), XVECEXP (y, i, j)) == 0)
+- 	      return 0;
+- 	  break;
+- 
+- 	case 'e':
+- 	  if (rtx_equal_for_memref_p (XEXP (x, i), XEXP (y, i)) == 0)
+- 	    return 0;
+- 	  break;
+- 
+- 	case 'S':
+- 	case 's':
+- 	  if (strcmp (XSTR (x, i), XSTR (y, i)))
+- 	    return 0;
+- 	  break;
+- 
+- 	case 'u':
+- 	  /* These are just backpointers, so they don't matter.  */
+- 	  break;
+- 
+- 	case '0':
+- 	  break;
+- 
+- 	  /* It is believed that rtx's at this level will never
+- 	     contain anything but integers and other rtx's,
+- 	     except for within LABEL_REFs and SYMBOL_REFs.  */
+- 	default:
+- 	  abort ();
+- 	}
+-     }
+-   return 1;
+- }
+- 
+- /* Given an rtx X, find a SYMBOL_REF or LABEL_REF within
+-    X and return it, or return 0 if none found.  */
+- 
+- static rtx
+- find_symbolic_term (x)
+-      rtx x;
+- {
+-   register int i;
+-   register enum rtx_code code;
+-   register char *fmt;
+- 
+-   code = GET_CODE (x);
+-   if (code == SYMBOL_REF || code == LABEL_REF)
+-     return x;
+-   if (GET_RTX_CLASS (code) == 'o')
+-     return 0;
+- 
+-   fmt = GET_RTX_FORMAT (code);
+-   for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--)
+-     {
+-       rtx t;
+- 
+-       if (fmt[i] == 'e')
+- 	{
+- 	  t = find_symbolic_term (XEXP (x, i));
+- 	  if (t != 0)
+- 	    return t;
+- 	}
+-       else if (fmt[i] == 'E')
+- 	break;
+-     }
+-   return 0;
+- }
+- 
+- /* Return nonzero if X and Y (memory addresses) could reference the
+-    same location in memory.  C is an offset accumulator.  When
+-    C is nonzero, we are testing aliases between X and Y + C.
+-    XSIZE is the size in bytes of the X reference,
+-    similarly YSIZE is the size in bytes for Y.
+- 
+-    If XSIZE or YSIZE is zero, we do not know the amount of memory being
+-    referenced (the reference was BLKmode), so make the most pessimistic
+-    assumptions.
+- 
+-    We recognize the following cases of non-conflicting memory:
+- 
+- 	(1) addresses involving the frame pointer cannot conflict
+- 	    with addresses involving static variables.
+- 	(2) static variables with different addresses cannot conflict.
+- 
+-    Nice to notice that varying addresses cannot conflict with fp if no
+-    local variables had their addresses taken, but that's too hard now.  */
+- 
+- /* ??? In Fortran, references to a array parameter can never conflict with
+-    another array parameter.  */
+- 
+- static int
+- memrefs_conflict_p (xsize, x, ysize, y, c)
+-      rtx x, y;
+-      int xsize, ysize;
+-      HOST_WIDE_INT c;
+- {
+-   if (GET_CODE (x) == HIGH)
+-     x = XEXP (x, 0);
+-   else if (GET_CODE (x) == LO_SUM)
+-     x = XEXP (x, 1);
+-   else
+-     x = canon_rtx (x);
+-   if (GET_CODE (y) == HIGH)
+-     y = XEXP (y, 0);
+-   else if (GET_CODE (y) == LO_SUM)
+-     y = XEXP (y, 1);
+-   else
+-     y = canon_rtx (y);
+- 
+-   if (rtx_equal_for_memref_p (x, y))
+-     return (xsize == 0 || ysize == 0 ||
+- 	    (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0));
+- 
+-   if (y == frame_pointer_rtx || y == hard_frame_pointer_rtx
+-       || y == stack_pointer_rtx)
+-     {
+-       rtx t = y;
+-       int tsize = ysize;
+-       y = x; ysize = xsize;
+-       x = t; xsize = tsize;
+-     }
+- 
+-   if (x == frame_pointer_rtx || x == hard_frame_pointer_rtx
+-       || x == stack_pointer_rtx)
+-     {
+-       rtx y1;
+- 
+-       if (CONSTANT_P (y))
+- 	return 0;
+- 
+-       if (GET_CODE (y) == PLUS
+- 	  && canon_rtx (XEXP (y, 0)) == x
+- 	  && (y1 = canon_rtx (XEXP (y, 1)))
+- 	  && GET_CODE (y1) == CONST_INT)
+- 	{
+- 	  c += INTVAL (y1);
+- 	  return (xsize == 0 || ysize == 0
+- 		  || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0));
+- 	}
+- 
+-       if (GET_CODE (y) == PLUS
+- 	  && (y1 = canon_rtx (XEXP (y, 0)))
+- 	  && CONSTANT_P (y1))
+- 	return 0;
+- 
+-       return 1;
+-     }
+- 
+-   if (GET_CODE (x) == PLUS)
+-     {
+-       /* The fact that X is canonicalized means that this
+- 	 PLUS rtx is canonicalized.  */
+-       rtx x0 = XEXP (x, 0);
+-       rtx x1 = XEXP (x, 1);
+- 
+-       if (GET_CODE (y) == PLUS)
+- 	{
+- 	  /* The fact that Y is canonicalized means that this
+- 	     PLUS rtx is canonicalized.  */
+- 	  rtx y0 = XEXP (y, 0);
+- 	  rtx y1 = XEXP (y, 1);
+- 
+- 	  if (rtx_equal_for_memref_p (x1, y1))
+- 	    return memrefs_conflict_p (xsize, x0, ysize, y0, c);
+- 	  if (rtx_equal_for_memref_p (x0, y0))
+- 	    return memrefs_conflict_p (xsize, x1, ysize, y1, c);
+- 	  if (GET_CODE (x1) == CONST_INT)
+- 	    if (GET_CODE (y1) == CONST_INT)
+- 	      return memrefs_conflict_p (xsize, x0, ysize, y0,
+- 					 c - INTVAL (x1) + INTVAL (y1));
+- 	    else
+- 	      return memrefs_conflict_p (xsize, x0, ysize, y, c - INTVAL (x1));
+- 	  else if (GET_CODE (y1) == CONST_INT)
+- 	    return memrefs_conflict_p (xsize, x, ysize, y0, c + INTVAL (y1));
+- 
+- 	  /* Handle case where we cannot understand iteration operators,
+- 	     but we notice that the base addresses are distinct objects.  */
+- 	  x = find_symbolic_term (x);
+- 	  if (x == 0)
+- 	    return 1;
+- 	  y = find_symbolic_term (y);
+- 	  if (y == 0)
+- 	    return 1;
+- 	  return rtx_equal_for_memref_p (x, y);
+- 	}
+-       else if (GET_CODE (x1) == CONST_INT)
+- 	return memrefs_conflict_p (xsize, x0, ysize, y, c - INTVAL (x1));
+-     }
+-   else if (GET_CODE (y) == PLUS)
+-     {
+-       /* The fact that Y is canonicalized means that this
+- 	 PLUS rtx is canonicalized.  */
+-       rtx y0 = XEXP (y, 0);
+-       rtx y1 = XEXP (y, 1);
+- 
+-       if (GET_CODE (y1) == CONST_INT)
+- 	return memrefs_conflict_p (xsize, x, ysize, y0, c + INTVAL (y1));
+-       else
+- 	return 1;
+-     }
+- 
+-   if (GET_CODE (x) == GET_CODE (y))
+-     switch (GET_CODE (x))
+-       {
+-       case MULT:
+- 	{
+- 	  /* Handle cases where we expect the second operands to be the
+- 	     same, and check only whether the first operand would conflict
+- 	     or not.  */
+- 	  rtx x0, y0;
+- 	  rtx x1 = canon_rtx (XEXP (x, 1));
+- 	  rtx y1 = canon_rtx (XEXP (y, 1));
+- 	  if (! rtx_equal_for_memref_p (x1, y1))
+- 	    return 1;
+- 	  x0 = canon_rtx (XEXP (x, 0));
+- 	  y0 = canon_rtx (XEXP (y, 0));
+- 	  if (rtx_equal_for_memref_p (x0, y0))
+- 	    return (xsize == 0 || ysize == 0
+- 		    || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0));
+- 
+- 	  /* Can't properly adjust our sizes.  */
+- 	  if (GET_CODE (x1) != CONST_INT)
+- 	    return 1;
+- 	  xsize /= INTVAL (x1);
+- 	  ysize /= INTVAL (x1);
+- 	  c /= INTVAL (x1);
+- 	  return memrefs_conflict_p (xsize, x0, ysize, y0, c);
+- 	}
+-       }
+- 
+-   if (CONSTANT_P (x))
+-     {
+-       if (GET_CODE (x) == CONST_INT && GET_CODE (y) == CONST_INT)
+- 	{
+- 	  c += (INTVAL (y) - INTVAL (x));
+- 	  return (xsize == 0 || ysize == 0
+- 		  || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0));
+- 	}
+- 
+-       if (GET_CODE (x) == CONST)
+- 	{
+- 	  if (GET_CODE (y) == CONST)
+- 	    return memrefs_conflict_p (xsize, canon_rtx (XEXP (x, 0)),
+- 				       ysize, canon_rtx (XEXP (y, 0)), c);
+- 	  else
+- 	    return memrefs_conflict_p (xsize, canon_rtx (XEXP (x, 0)),
+- 				       ysize, y, c);
+- 	}
+-       if (GET_CODE (y) == CONST)
+- 	return memrefs_conflict_p (xsize, x, ysize,
+- 				   canon_rtx (XEXP (y, 0)), c);
+- 
+-       if (CONSTANT_P (y))
+- 	return (rtx_equal_for_memref_p (x, y)
+- 		&& (xsize == 0 || ysize == 0
+- 		    || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0)));
+- 
+-       return 1;
+-     }
+-   return 1;
+- }
+- 
+- /* Functions to compute memory dependencies.
+- 
+-    Since we process the insns in execution order, we can build tables
+-    to keep track of what registers are fixed (and not aliased), what registers
+-    are varying in known ways, and what registers are varying in unknown
+-    ways.
+- 
+-    If both memory references are volatile, then there must always be a
+-    dependence between the two references, since their order can not be
+-    changed.  A volatile and non-volatile reference can be interchanged
+-    though. 
+- 
+-    A MEM_IN_STRUCT reference at a non-QImode varying address can never
+-    conflict with a non-MEM_IN_STRUCT reference at a fixed address.   We must
+-    allow QImode aliasing because the ANSI C standard allows character
+-    pointers to alias anything.  We are assuming that characters are
+-    always QImode here.  */
+- 
+- /* Read dependence: X is read after read in MEM takes place.  There can
+-    only be a dependence here if both reads are volatile.  */
+- 
+- int
+- read_dependence (mem, x)
+-      rtx mem;
+-      rtx x;
+- {
+-   return MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem);
+- }
+- 
+- /* True dependence: X is read after store in MEM takes place.  */
+- 
+- int
+- true_dependence (mem, x)
+-      rtx mem;
+-      rtx x;
+- {
+-   /* If X is an unchanging read, then it can't possibly conflict with any
+-      non-unchanging store.  It may conflict with an unchanging write though,
+-      because there may be a single store to this address to initialize it.
+-      Just fall through to the code below to resolve the case where we have
+-      both an unchanging read and an unchanging write.  This won't handle all
+-      cases optimally, but the possible performance loss should be
+-      negligible.  */
+-   if (RTX_UNCHANGING_P (x) && ! RTX_UNCHANGING_P (mem))
+-     return 0;
+- 
+-   return ((MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem))
+- 	  || (memrefs_conflict_p (SIZE_FOR_MODE (mem), XEXP (mem, 0),
+- 				  SIZE_FOR_MODE (x), XEXP (x, 0), 0)
+- 	      && ! (MEM_IN_STRUCT_P (mem) && rtx_addr_varies_p (mem)
+- 		    && GET_MODE (mem) != QImode
+- 		    && ! MEM_IN_STRUCT_P (x) && ! rtx_addr_varies_p (x))
+- 	      && ! (MEM_IN_STRUCT_P (x) && rtx_addr_varies_p (x)
+- 		    && GET_MODE (x) != QImode
+- 		    && ! MEM_IN_STRUCT_P (mem) && ! rtx_addr_varies_p (mem))));
+- }
+- 
+- /* Anti dependence: X is written after read in MEM takes place.  */
+- 
+- int
+- anti_dependence (mem, x)
+-      rtx mem;
+-      rtx x;
+- {
+-   /* If MEM is an unchanging read, then it can't possibly conflict with
+-      the store to X, because there is at most one store to MEM, and it must
+-      have occurred somewhere before MEM.  */
+-   if (RTX_UNCHANGING_P (mem))
+-     return 0;
+- 
+-   return ((MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem))
+- 	  || (memrefs_conflict_p (SIZE_FOR_MODE (mem), XEXP (mem, 0),
+- 				  SIZE_FOR_MODE (x), XEXP (x, 0), 0)
+- 	      && ! (MEM_IN_STRUCT_P (mem) && rtx_addr_varies_p (mem)
+- 		    && GET_MODE (mem) != QImode
+- 		    && ! MEM_IN_STRUCT_P (x) && ! rtx_addr_varies_p (x))
+- 	      && ! (MEM_IN_STRUCT_P (x) && rtx_addr_varies_p (x)
+- 		    && GET_MODE (x) != QImode
+- 		    && ! MEM_IN_STRUCT_P (mem) && ! rtx_addr_varies_p (mem))));
+- }
+- 
+- /* Output dependence: X is written after store in MEM takes place.  */
+- 
+- int
+- output_dependence (mem, x)
+-      rtx mem;
+-      rtx x;
+- {
+-   return ((MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem))
+- 	  || (memrefs_conflict_p (SIZE_FOR_MODE (mem), XEXP (mem, 0),
+- 				  SIZE_FOR_MODE (x), XEXP (x, 0), 0)
+- 	      && ! (MEM_IN_STRUCT_P (mem) && rtx_addr_varies_p (mem)
+- 		    && GET_MODE (mem) != QImode
+- 		    && ! MEM_IN_STRUCT_P (x) && ! rtx_addr_varies_p (x))
+- 	      && ! (MEM_IN_STRUCT_P (x) && rtx_addr_varies_p (x)
+- 		    && GET_MODE (x) != QImode
+- 		    && ! MEM_IN_STRUCT_P (mem) && ! rtx_addr_varies_p (mem))));
+- }
+- 
+  /* Helper functions for instruction scheduling.  */
+  
+--- 345,348 ----
+*************** add_insn_mem_dependence (insn_list, mem_
+*** 1609,1621 ****
+  
+  /* Make a dependency between every memory reference on the pending lists
+!    and INSN, thus flushing the pending lists.  */
+  
+  static void
+! flush_pending_lists (insn)
+       rtx insn;
+  {
+    rtx link;
+  
+!   while (pending_read_insns)
+      {
+        add_dependence (insn, XEXP (pending_read_insns, 0), REG_DEP_ANTI);
+--- 1072,1086 ----
+  
+  /* Make a dependency between every memory reference on the pending lists
+!    and INSN, thus flushing the pending lists.  If ONLY_WRITE, don't flush
+!    the read list.  */
+  
+  static void
+! flush_pending_lists (insn, only_write)
+       rtx insn;
++      int only_write;
+  {
+    rtx link;
+  
+!   while (pending_read_insns && ! only_write)
+      {
+        add_dependence (insn, XEXP (pending_read_insns, 0), REG_DEP_ANTI);
+*************** sched_analyze_1 (x, insn)
+*** 1746,1750 ****
+  	     this flush occurs 8 times for sparc, and 10 times for m88k using
+  	     the number 32.  */
+! 	  flush_pending_lists (insn);
+  	}
+        else
+--- 1211,1215 ----
+  	     this flush occurs 8 times for sparc, and 10 times for m88k using
+  	     the number 32.  */
+! 	  flush_pending_lists (insn, 0);
+  	}
+        else
+*************** sched_analyze_2 (x, insn)
+*** 1922,1926 ****
+  	    /* If a dependency already exists, don't create a new one.  */
+  	    if (! find_insn_list (XEXP (pending, 0), LOG_LINKS (insn)))
+! 	      if (true_dependence (XEXP (pending_mem, 0), x))
+  		add_dependence (insn, XEXP (pending, 0), 0);
+  
+--- 1387,1392 ----
+  	    /* If a dependency already exists, don't create a new one.  */
+  	    if (! find_insn_list (XEXP (pending, 0), LOG_LINKS (insn)))
+! 	      if (true_dependence (XEXP (pending_mem, 0), VOIDmode,
+! 				   x, rtx_varies_p))
+  		add_dependence (insn, XEXP (pending, 0), 0);
+  
+*************** sched_analyze_2 (x, insn)
+*** 1968,1972 ****
+  	    reg_pending_sets_all = 1;
+  
+! 	    flush_pending_lists (insn);
+  	  }
+  
+--- 1434,1438 ----
+  	    reg_pending_sets_all = 1;
+  
+! 	    flush_pending_lists (insn, 0);
+  	  }
+  
+*************** sched_analyze_insn (x, insn, loop_notes)
+*** 2021,2025 ****
+    register RTX_CODE code = GET_CODE (x);
+    rtx link;
+!   int maxreg = max_reg_num ();
+    int i;
+  
+--- 1487,1491 ----
+    register RTX_CODE code = GET_CODE (x);
+    rtx link;
+!   int maxreg = reg_last_uses_size;
+    int i;
+  
+*************** sched_analyze_insn (x, insn, loop_notes)
+*** 2058,2062 ****
+    if (loop_notes)
+      {
+!       int max_reg = max_reg_num ();
+        rtx link;
+  
+--- 1524,1528 ----
+    if (loop_notes)
+      {
+!       int max_reg = reg_last_uses_size;
+        rtx link;
+  
+*************** sched_analyze_insn (x, insn, loop_notes)
+*** 2072,2076 ****
+        reg_pending_sets_all = 1;
+  
+!       flush_pending_lists (insn);
+  
+        link = loop_notes;
+--- 1538,1542 ----
+        reg_pending_sets_all = 1;
+  
+!       flush_pending_lists (insn, 0);
+  
+        link = loop_notes;
+*************** sched_analyze (head, tail)
+*** 2202,2207 ****
+  	      && NOTE_LINE_NUMBER (NEXT_INSN (insn)) == NOTE_INSN_SETJMP)
+  	    {
+! 	      int max_reg = max_reg_num ();
+! 	      for (i = 0; i < max_reg; i++)
+  		{
+  		  for (u = reg_last_uses[i]; u; u = XEXP (u, 1))
+--- 1668,1672 ----
+  	      && NOTE_LINE_NUMBER (NEXT_INSN (insn)) == NOTE_INSN_SETJMP)
+  	    {
+! 	      for (i = 0; i < reg_last_uses_size; i++)
+  		{
+  		  for (u = reg_last_uses[i]; u; u = XEXP (u, 1))
+*************** sched_analyze (head, tail)
+*** 2247,2259 ****
+  	  loop_notes = 0;
+  
+! 	  /* We don't need to flush memory for a function call which does
+! 	     not involve memory.  */
+! 	  if (! CONST_CALL_P (insn))
+! 	    {
+! 	      /* In the absence of interprocedural alias analysis,
+! 		 we must flush all pending reads and writes, and
+! 		 start new dependencies starting from here.  */
+! 	      flush_pending_lists (insn);
+! 	    }
+  
+  	  /* Depend this function call (actually, the user of this
+--- 1712,1720 ----
+  	  loop_notes = 0;
+  
+! 	  /* In the absence of interprocedural alias analysis, we must flush
+! 	     all pending reads and writes, and start new dependencies starting
+! 	     from here.  But only flush writes for constant calls (which may
+! 	     be passed a pointer to something we haven't written yet).  */
+! 	  flush_pending_lists (insn, CONST_CALL_P (insn));
+  
+  	  /* Depend this function call (actually, the user of this
+*************** sched_analyze (head, tail)
+*** 2264,2270 ****
+        else if (GET_CODE (insn) == NOTE
+  	       && (NOTE_LINE_NUMBER (insn) == NOTE_INSN_LOOP_BEG
+! 		   || NOTE_LINE_NUMBER (insn) == NOTE_INSN_LOOP_END))
+! 	loop_notes = gen_rtx (EXPR_LIST, REG_DEAD,
+! 			      GEN_INT (NOTE_LINE_NUMBER (insn)), loop_notes);
+  
+        if (insn == tail)
+--- 1725,1736 ----
+        else if (GET_CODE (insn) == NOTE
+  	       && (NOTE_LINE_NUMBER (insn) == NOTE_INSN_LOOP_BEG
+! 		   || NOTE_LINE_NUMBER (insn) == NOTE_INSN_LOOP_END
+! 		   || (NOTE_LINE_NUMBER (insn) == NOTE_INSN_SETJMP
+! 		       && GET_CODE (PREV_INSN (insn)) != CALL_INSN)))
+! 	{
+! 	  loop_notes = gen_rtx (EXPR_LIST, REG_DEAD,
+! 				GEN_INT (NOTE_LINE_NUMBER (insn)), loop_notes);
+! 	  CONST_CALL_P (loop_notes) = CONST_CALL_P (insn);
+! 	}
+  
+        if (insn == tail)
+*************** sched_note_set (b, x, death)
+*** 2372,2380 ****
+  
+  #define SCHED_SORT(READY, NEW_READY, OLD_READY) \
+!   do { if ((NEW_READY) - (OLD_READY) == 1)				\
+! 	 swap_sort (READY, NEW_READY);					\
+!        else if ((NEW_READY) - (OLD_READY) > 1)				\
+! 	 qsort (READY, NEW_READY, sizeof (rtx), rank_for_schedule); }	\
+!   while (0)
+  
+  /* Returns a positive value if y is preferred; returns a negative value if
+--- 1838,1845 ----
+  
+  #define SCHED_SORT(READY, NEW_READY, OLD_READY) \
+!   if ((NEW_READY) - (OLD_READY) == 1)					\
+!     swap_sort (READY, NEW_READY);					\
+!   else if ((NEW_READY) - (OLD_READY) > 1)				\
+!     qsort (READY, NEW_READY, sizeof (rtx), rank_for_schedule); else	\
+  
+  /* Returns a positive value if y is preferred; returns a negative value if
+*************** reemit_notes (insn, last)
+*** 3128,3132 ****
+  	{
+  	  if (INTVAL (XEXP (note, 0)) == NOTE_INSN_SETJMP)
+! 	    emit_note_after (INTVAL (XEXP (note, 0)), insn);
+  	  else
+  	    last = emit_note_before (INTVAL (XEXP (note, 0)), last);
+--- 2593,2598 ----
+  	{
+  	  if (INTVAL (XEXP (note, 0)) == NOTE_INSN_SETJMP)
+! 	    CONST_CALL_P (emit_note_after (INTVAL (XEXP (note, 0)), insn))
+! 	      = CONST_CALL_P (note);
+  	  else
+  	    last = emit_note_before (INTVAL (XEXP (note, 0)), last);
+*************** schedule_block (b, file)
+*** 3174,3178 ****
+  	     b, INSN_UID (basic_block_head[b]), INSN_UID (basic_block_end[b]));
+  
+!   i = max_reg_num ();
+    reg_last_uses = (rtx *) alloca (i * sizeof (rtx));
+    bzero ((char *) reg_last_uses, i * sizeof (rtx));
+--- 2640,2644 ----
+  	     b, INSN_UID (basic_block_head[b]), INSN_UID (basic_block_end[b]));
+  
+!   reg_last_uses_size = i = max_reg_num ();
+    reg_last_uses = (rtx *) alloca (i * sizeof (rtx));
+    bzero ((char *) reg_last_uses, i * sizeof (rtx));
+*************** schedule_block (b, file)
+*** 3800,3804 ****
+  		     made live again later.  */
+  		  for (i = 0; i < FIRST_PSEUDO_REGISTER; i++)
+! 		    if (call_used_regs[i] || global_regs[i])
+  		      {
+  			register int offset = i / REGSET_ELT_BITS;
+--- 3266,3271 ----
+  		     made live again later.  */
+  		  for (i = 0; i < FIRST_PSEUDO_REGISTER; i++)
+! 		    if ((call_used_regs[i] && ! fixed_regs[i])
+! 			|| global_regs[i])
+  		      {
+  			register int offset = i / REGSET_ELT_BITS;
+*************** schedule_insns (dump_file)
+*** 4717,4721 ****
+        bcopy ((char *) reg_n_deaths, (char *) sched_reg_n_deaths,
+  	     max_regno * sizeof (short));
+-       init_alias_analysis ();
+      }
+    else
+--- 4184,4187 ----
+*************** schedule_insns (dump_file)
+*** 4726,4732 ****
+        bb_dead_regs = 0;
+        bb_live_regs = 0;
+-       if (! flag_schedule_insns)
+- 	init_alias_analysis ();
+      }
+  
+    if (write_symbols != NO_DEBUG)
+--- 4192,4213 ----
+        bb_dead_regs = 0;
+        bb_live_regs = 0;
+      }
++   init_alias_analysis ();
++ #if 0
++   if (dump_file)
++     {
++       extern rtx *reg_base_value;
++       extern int reg_base_value_size;
++       int i;
++       for (i = 0; i < reg_base_value_size; i++)
++ 	if (reg_base_value[i])
++ 	  {
++ 	    fprintf (dump_file, ";; reg_base_value[%d] = ", i);
++ 	    print_rtl (dump_file, reg_base_value[i]);
++ 	    fputc ('\n', dump_file);
++ 	  }
++     }
++ #endif
++ 
+  
+    if (write_symbols != NO_DEBUG)
+diff -rcp2N gcc-2.7.2.2/sdbout.c g77-new/sdbout.c
+*** gcc-2.7.2.2/sdbout.c	Thu Jun 15 08:07:11 1995
+--- g77-new/sdbout.c	Mon Aug 11 01:42:22 1997
+*************** plain_type_1 (type, level)
+*** 539,543 ****
+  	  sdb_dims[sdb_n_dims++]
+  	    = (TYPE_DOMAIN (type)
+! 	       ? TREE_INT_CST_LOW (TYPE_MAX_VALUE (TYPE_DOMAIN (type))) + 1
+  	       : 0);
+  	return PUSH_DERIVED_LEVEL (DT_ARY, m);
+--- 539,546 ----
+  	  sdb_dims[sdb_n_dims++]
+  	    = (TYPE_DOMAIN (type)
+! 	       && TREE_CODE (TYPE_MAX_VALUE (TYPE_DOMAIN (type))) == INTEGER_CST
+! 	       && TREE_CODE (TYPE_MIN_VALUE (TYPE_DOMAIN (type))) == INTEGER_CST
+! 	       ? (TREE_INT_CST_LOW (TYPE_MAX_VALUE (TYPE_DOMAIN (type)))
+! 		  - TREE_INT_CST_LOW (TYPE_MIN_VALUE (TYPE_DOMAIN (type))) + 1)
+  	       : 0);
+  	return PUSH_DERIVED_LEVEL (DT_ARY, m);
+diff -rcp2N gcc-2.7.2.2/stmt.c g77-new/stmt.c
+*** gcc-2.7.2.2/stmt.c	Tue Sep 12 19:01:54 1995
+--- g77-new/stmt.c	Sun Aug 10 18:46:56 1997
+*************** fixup_gotos (thisblock, stack_level, cle
+*** 1244,1249 ****
+  	      poplevel (1, 0, 0);
+  	      end_sequence ();
+! 	      f->before_jump
+! 		= emit_insns_after (cleanup_insns, f->before_jump);
+  
+  	      f->cleanup_list_list = TREE_CHAIN (lists);
+--- 1244,1250 ----
+  	      poplevel (1, 0, 0);
+  	      end_sequence ();
+! 	      if (cleanup_insns != 0)
+! 		f->before_jump
+! 		  = emit_insns_after (cleanup_insns, f->before_jump);
+  
+  	      f->cleanup_list_list = TREE_CHAIN (lists);
+*************** expand_expr_stmt (exp)
+*** 1721,1725 ****
+  
+    last_expr_type = TREE_TYPE (exp);
+!   if (! flag_syntax_only)
+      last_expr_value = expand_expr (exp,
+  				   (expr_stmts_for_value
+--- 1722,1726 ----
+  
+    last_expr_type = TREE_TYPE (exp);
+!   if (! flag_syntax_only || expr_stmts_for_value)
+      last_expr_value = expand_expr (exp,
+  				   (expr_stmts_for_value
+*************** expand_end_bindings (vars, mark_ends, do
+*** 3160,3163 ****
+--- 3161,3169 ----
+  #endif
+  
++ #ifdef HAVE_nonlocal_goto_receiver
++       if (HAVE_nonlocal_goto_receiver)
++ 	emit_insn (gen_nonlocal_goto_receiver ());
++ #endif
++ 
+        /* The handler expects the desired label address in the static chain
+  	 register.  It tests the address and does an appropriate jump
+*************** expand_decl (decl)
+*** 3369,3393 ****
+  	= promote_mode (type, DECL_MODE (decl), &unsignedp, 0);
+  
+!       if (TREE_CODE (type) == COMPLEX_TYPE)
+! 	{
+! 	  rtx realpart, imagpart;
+! 	  enum machine_mode partmode = TYPE_MODE (TREE_TYPE (type));
+  
+! 	  /* For a complex type variable, make a CONCAT of two pseudos
+! 	     so that the real and imaginary parts
+! 	     can be allocated separately.  */
+! 	  realpart = gen_reg_rtx (partmode);
+! 	  REG_USERVAR_P (realpart) = 1;
+! 	  imagpart = gen_reg_rtx (partmode);
+! 	  REG_USERVAR_P (imagpart) = 1;
+! 	  DECL_RTL (decl) = gen_rtx (CONCAT, reg_mode, realpart, imagpart);
+! 	}
+!       else
+! 	{
+! 	  DECL_RTL (decl) = gen_reg_rtx (reg_mode);
+! 	  if (TREE_CODE (type) == POINTER_TYPE)
+! 	    mark_reg_pointer (DECL_RTL (decl));
+! 	  REG_USERVAR_P (DECL_RTL (decl)) = 1;
+! 	}
+      }
+    else if (TREE_CODE (DECL_SIZE (decl)) == INTEGER_CST)
+--- 3375,3383 ----
+  	= promote_mode (type, DECL_MODE (decl), &unsignedp, 0);
+  
+!       DECL_RTL (decl) = gen_reg_rtx (reg_mode);
+!       mark_user_reg (DECL_RTL (decl));
+  
+!       if (TREE_CODE (type) == POINTER_TYPE)
+! 	mark_reg_pointer (DECL_RTL (decl));
+      }
+    else if (TREE_CODE (DECL_SIZE (decl)) == INTEGER_CST)
+*************** expand_decl (decl)
+*** 3462,3468 ****
+        free_temp_slots ();
+  
+!       /* Allocate space on the stack for the variable.  */
+        address = allocate_dynamic_stack_space (size, NULL_RTX,
+! 					      DECL_ALIGN (decl));
+  
+        /* Reference the variable indirect through that rtx.  */
+--- 3452,3461 ----
+        free_temp_slots ();
+  
+!       /* Allocate space on the stack for the variable.  Note that
+! 	 DECL_ALIGN says how the variable is to be aligned and we 
+! 	 cannot use it to conclude anything about the alignment of
+! 	 the size.  */
+        address = allocate_dynamic_stack_space (size, NULL_RTX,
+! 					      TYPE_ALIGN (TREE_TYPE (decl)));
+  
+        /* Reference the variable indirect through that rtx.  */
+diff -rcp2N gcc-2.7.2.2/stor-layout.c g77-new/stor-layout.c
+*** gcc-2.7.2.2/stor-layout.c	Thu Feb 20 19:24:20 1997
+--- g77-new/stor-layout.c	Mon Aug 11 06:47:50 1997
+*************** layout_decl (decl, known_align)
+*** 255,259 ****
+        if (maximum_field_alignment != 0)
+  	DECL_ALIGN (decl) = MIN (DECL_ALIGN (decl), maximum_field_alignment);
+!       else if (flag_pack_struct)
+  	DECL_ALIGN (decl) = MIN (DECL_ALIGN (decl), BITS_PER_UNIT);
+      }
+--- 255,259 ----
+        if (maximum_field_alignment != 0)
+  	DECL_ALIGN (decl) = MIN (DECL_ALIGN (decl), maximum_field_alignment);
+!       else if (DECL_PACKED (decl))
+  	DECL_ALIGN (decl) = MIN (DECL_ALIGN (decl), BITS_PER_UNIT);
+      }
+*************** layout_decl (decl, known_align)
+*** 261,265 ****
+    if (DECL_BIT_FIELD (decl)
+        && TYPE_SIZE (type) != 0
+!       && TREE_CODE (TYPE_SIZE (type)) == INTEGER_CST)
+      {
+        register enum machine_mode xmode
+--- 261,266 ----
+    if (DECL_BIT_FIELD (decl)
+        && TYPE_SIZE (type) != 0
+!       && TREE_CODE (TYPE_SIZE (type)) == INTEGER_CST
+!       && GET_MODE_CLASS (TYPE_MODE (type)) == MODE_INT)
+      {
+        register enum machine_mode xmode
+*************** layout_decl (decl, known_align)
+*** 278,281 ****
+--- 279,291 ----
+      }
+  
++   /* Turn off DECL_BIT_FIELD if we won't need it set.  */
++   if (DECL_BIT_FIELD (decl) && TYPE_MODE (type) == BLKmode
++       && known_align % TYPE_ALIGN (type) == 0
++       && DECL_SIZE (decl) != 0
++       && (TREE_CODE (DECL_SIZE (decl)) != INTEGER_CST
++ 	  || (TREE_INT_CST_LOW (DECL_SIZE (decl)) % BITS_PER_UNIT) == 0)
++       && DECL_ALIGN (decl) >= TYPE_ALIGN (type))
++     DECL_BIT_FIELD (decl) = 0;
++ 
+    /* Evaluate nonconstant size only once, either now or as soon as safe.  */
+    if (DECL_SIZE (decl) != 0 && TREE_CODE (DECL_SIZE (decl)) != INTEGER_CST)
+*************** layout_record (rec)
+*** 380,384 ****
+  	      if (maximum_field_alignment != 0)
+  		type_align = MIN (type_align, maximum_field_alignment);
+! 	      else if (flag_pack_struct)
+  		type_align = MIN (type_align, BITS_PER_UNIT);
+  
+--- 390,394 ----
+  	      if (maximum_field_alignment != 0)
+  		type_align = MIN (type_align, maximum_field_alignment);
+! 	      else if (TYPE_PACKED (rec))
+  		type_align = MIN (type_align, BITS_PER_UNIT);
+  
+*************** layout_record (rec)
+*** 422,428 ****
+  	  && DECL_BIT_FIELD_TYPE (field)
+  	  && !DECL_PACKED (field)
+- 	  /* If #pragma pack is in effect, turn off this feature.  */
+  	  && maximum_field_alignment == 0
+- 	  && !flag_pack_struct
+  	  && !integer_zerop (DECL_SIZE (field)))
+  	{
+--- 432,436 ----
+*************** layout_record (rec)
+*** 459,463 ****
+  	  if (maximum_field_alignment != 0)
+  	    type_align = MIN (type_align, maximum_field_alignment);
+! 	  else if (flag_pack_struct)
+  	    type_align = MIN (type_align, BITS_PER_UNIT);
+  
+--- 467,471 ----
+  	  if (maximum_field_alignment != 0)
+  	    type_align = MIN (type_align, maximum_field_alignment);
+! 	  else if (TYPE_PACKED (rec))
+  	    type_align = MIN (type_align, BITS_PER_UNIT);
+  
+*************** layout_record (rec)
+*** 500,505 ****
+  	  /* Do nothing.  */;
+  	else if (TREE_CODE (dsize) == INTEGER_CST
+  		 && TREE_INT_CST_HIGH (dsize) == 0
+! 		 && TREE_INT_CST_LOW (dsize) + const_size > const_size)
+  	  /* Use const_size if there's no overflow.  */
+  	  const_size += TREE_INT_CST_LOW (dsize);
+--- 508,514 ----
+  	  /* Do nothing.  */;
+  	else if (TREE_CODE (dsize) == INTEGER_CST
++ 		 && ! TREE_CONSTANT_OVERFLOW (dsize)
+  		 && TREE_INT_CST_HIGH (dsize) == 0
+! 		 && TREE_INT_CST_LOW (dsize) + const_size >= const_size)
+  	  /* Use const_size if there's no overflow.  */
+  	  const_size += TREE_INT_CST_LOW (dsize);
+*************** get_best_mode (bitsize, bitpos, align, l
+*** 1172,1175 ****
+--- 1181,1192 ----
+    enum machine_mode mode;
+    int unit;
++ 
++   if (bitpos < 0)
++     {
++       /* For correct calculations and convenience, bias negative bitpos
++ 	 to become a non-negative value that is [1,bitsize], such that
++ 	 the relative bit offset to a multiple of bitsize is preserved.  */
++       bitpos = bitsize - ((-bitpos) % bitsize);
++     }
+  
+    /* Find the narrowest integer mode that contains the bit field.  */
+diff -rcp2N gcc-2.7.2.2/stupid.c g77-new/stupid.c
+*** gcc-2.7.2.2/stupid.c	Sun Oct 29 07:45:22 1995
+--- g77-new/stupid.c	Sun Aug 10 18:46:01 1997
+*************** static int *uid_suid;
+*** 66,69 ****
+--- 66,74 ----
+  static int last_call_suid;
+  
++ /* Record the suid of the last NOTE_INSN_SETJMP
++    so we can tell whether a pseudo reg crosses any setjmp.  */
++ 
++ static int last_setjmp_suid;
++ 
+  /* Element N is suid of insn where life span of pseudo reg N ends.
+     Element is  0 if register N has not been seen yet on backward scan.  */
+*************** static char *regs_live;
+*** 89,92 ****
+--- 94,101 ----
+  static char *regs_change_size;
+  
++ /* Indexed by reg number, nonzero if reg crosses a setjmp.  */
++ 
++ static char *regs_crosses_setjmp;
++ 
+  /* Indexed by insn's suid, the set of hard regs live after that insn.  */
+  
+*************** stupid_life_analysis (f, nregs, file)
+*** 149,152 ****
+--- 158,162 ----
+  
+    last_call_suid = i + 1;
++   last_setjmp_suid = i + 1;
+    max_suid = i + 1;
+  
+*************** stupid_life_analysis (f, nregs, file)
+*** 167,170 ****
+--- 177,183 ----
+    bzero ((char *) regs_change_size, nregs * sizeof (char));
+  
++   regs_crosses_setjmp = (char *) alloca (nregs * sizeof (char));
++   bzero ((char *) regs_crosses_setjmp, nregs * sizeof (char));
++ 
+    reg_renumber = (short *) oballoc (nregs * sizeof (short));
+    for (i = 0; i < FIRST_PSEUDO_REGISTER; i++)
+*************** stupid_life_analysis (f, nregs, file)
+*** 216,219 ****
+--- 229,236 ----
+  	stupid_mark_refs (PATTERN (insn), insn);
+  
++       if (GET_CODE (insn) == NOTE
++ 	  && NOTE_LINE_NUMBER (insn) == NOTE_INSN_SETJMP)
++ 	last_setjmp_suid = INSN_SUID (insn);
++ 
+        /* Mark all call-clobbered regs as live after each call insn
+  	 so that a pseudo whose life span includes this insn
+*************** stupid_life_analysis (f, nregs, file)
+*** 254,259 ****
+        register int r = reg_order[i];
+  
+!       /* Some regnos disappear from the rtl.  Ignore them to avoid crash.  */
+!       if (regno_reg_rtx[r] == 0)
+  	continue;
+  
+--- 271,277 ----
+        register int r = reg_order[i];
+  
+!       /* Some regnos disappear from the rtl.  Ignore them to avoid crash. 
+! 	 Also don't allocate registers that cross a setjmp.  */
+!       if (regno_reg_rtx[r] == 0 || regs_crosses_setjmp[r])
+  	continue;
+  
+*************** stupid_reg_compare (r1p, r2p)
+*** 309,314 ****
+     that can hold a value of machine-mode MODE
+       (but actually we test only the first of the block for holding MODE)
+!    currently free from after insn whose suid is BIRTH
+!    through the insn whose suid is DEATH,
+     and return the number of the first of them.
+     Return -1 if such a block cannot be found.
+--- 327,332 ----
+     that can hold a value of machine-mode MODE
+       (but actually we test only the first of the block for holding MODE)
+!    currently free from after insn whose suid is BORN_INSN
+!    through the insn whose suid is DEAD_INSN,
+     and return the number of the first of them.
+     Return -1 if such a block cannot be found.
+*************** stupid_find_reg (call_preserved, class, 
+*** 338,341 ****
+--- 356,366 ----
+  #endif
+  
++   /* If this register's life is more than 5,000 insns, we probably
++      can't allocate it, so don't waste the time trying.  This avoid
++      quadratic behavior on programs that have regularly-occurring
++      SAVE_EXPRs.  */
++   if (dead_insn > born_insn + 5000)
++     return -1;
++ 
+    COPY_HARD_REG_SET (used,
+  		     call_preserved ? call_used_reg_set : fixed_reg_set);
+*************** stupid_mark_refs (x, insn)
+*** 488,491 ****
+--- 513,519 ----
+  	      if (last_call_suid < reg_where_dead[regno])
+  		reg_n_calls_crossed[regno] += 1;
++ 
++ 	      if (last_setjmp_suid < reg_where_dead[regno])
++ 		regs_crosses_setjmp[regno] = 1;
+  	    }
+  	}
+diff -rcp2N gcc-2.7.2.2/toplev.c g77-new/toplev.c
+*** gcc-2.7.2.2/toplev.c	Fri Oct 20 17:56:35 1995
+--- g77-new/toplev.c	Sun Aug 10 18:43:36 1997
+*************** int flag_unroll_loops;
+*** 388,391 ****
+--- 388,405 ----
+  int flag_unroll_all_loops;
+  
++ /* Nonzero forces all invariant computations in loops to be moved
++    outside the loop. */
++ 
++ int flag_move_all_movables = 0;
++ 
++ /* Nonzero forces all general induction variables in loops to be
++    strength reduced. */
++ 
++ int flag_reduce_all_givs = 0;
++ 
++ /* Nonzero gets another run of loop_optimize performed. */
++ 
++ int flag_rerun_loop_opt = 0;
++ 
+  /* Nonzero for -fwritable-strings:
+     store string constants in data segment and don't uniquize them.  */
+*************** int flag_gnu_linker = 1;
+*** 522,525 ****
+--- 536,550 ----
+  int flag_pack_struct = 0;
+  
++ /* 1 if alias checking is on (by default, when -O).  */
++ int flag_alias_check = 0;
++ 
++ /* 0 if pointer arguments may alias each other.  True in C.
++    1 if pointer arguments may not alias each other but may alias
++    global variables.
++    2 if pointer arguments may not alias each other and may not
++    alias global variables.  True in Fortran.
++    This defaults to 0 for C.  */
++ int flag_argument_noalias = 0;
++ 
+  /* Table of language-independent -f options.
+     STRING is the option name.  VARIABLE is the address of the variable.
+*************** struct { char *string; int *variable; in
+*** 542,545 ****
+--- 567,573 ----
+    {"unroll-loops", &flag_unroll_loops, 1},
+    {"unroll-all-loops", &flag_unroll_all_loops, 1},
++   {"move-all-movables", &flag_move_all_movables, 1},
++   {"reduce-all-givs", &flag_reduce_all_givs, 1},
++   {"rerun-loop-opt", &flag_rerun_loop_opt, 1},
+    {"writable-strings", &flag_writable_strings, 1},
+    {"peephole", &flag_no_peephole, 0},
+*************** struct { char *string; int *variable; in
+*** 568,572 ****
+    {"gnu-linker", &flag_gnu_linker, 1},
+    {"pack-struct", &flag_pack_struct, 1},
+!   {"bytecode", &output_bytecode, 1}
+  };
+  
+--- 596,604 ----
+    {"gnu-linker", &flag_gnu_linker, 1},
+    {"pack-struct", &flag_pack_struct, 1},
+!   {"bytecode", &output_bytecode, 1},
+!   {"alias-check", &flag_alias_check, 1},
+!   {"argument-alias", &flag_argument_noalias, 0},
+!   {"argument-noalias", &flag_argument_noalias, 1},
+!   {"argument-noalias-global", &flag_argument_noalias, 2}
+  };
+  
+*************** rest_of_compilation (decl)
+*** 2715,2725 ****
+  	 finish_compilation will call rest_of_compilation again
+  	 for those functions that need to be output.  Also defer those
+! 	 functions that we are supposed to defer.  */
+! 
+!       if (DECL_DEFER_OUTPUT (decl)
+! 	  || ((specd || DECL_INLINE (decl))
+! 	      && ((! TREE_PUBLIC (decl) && ! TREE_ADDRESSABLE (decl)
+! 		   && ! flag_keep_inline_functions)
+! 		  || DECL_EXTERNAL (decl))))
+  	{
+  	  DECL_DEFER_OUTPUT (decl) = 1;
+--- 2747,2760 ----
+  	 finish_compilation will call rest_of_compilation again
+  	 for those functions that need to be output.  Also defer those
+! 	 functions that we are supposed to defer.  We cannot defer
+! 	 functions containing nested functions since the nested function
+! 	 data is in our non-saved obstack.  */
+! 
+!       if (! current_function_contains_functions
+! 	  && (DECL_DEFER_OUTPUT (decl)
+! 	      || ((specd || DECL_INLINE (decl))
+! 		  && ((! TREE_PUBLIC (decl) && ! TREE_ADDRESSABLE (decl)
+! 		       && ! flag_keep_inline_functions)
+! 		      || DECL_EXTERNAL (decl)))))
+  	{
+  	  DECL_DEFER_OUTPUT (decl) = 1;
+*************** rest_of_compilation (decl)
+*** 2893,2897 ****
+--- 2928,2951 ----
+        TIMEVAR (loop_time,
+  	       {
++ 		 int save_unroll_flag;
++ 		 int save_unroll_all_flag;
++ 
++ 		 if (flag_rerun_loop_opt)
++ 		   {
++ 		     save_unroll_flag = flag_unroll_loops;
++ 		     save_unroll_all_flag = flag_unroll_all_loops;
++ 		     flag_unroll_loops = 0;
++ 		     flag_unroll_all_loops = 0;
++ 		   }
++ 
+  		 loop_optimize (insns, loop_dump_file);
++ 
++ 		 if (flag_rerun_loop_opt)
++ 		   {
++ 		     flag_unroll_loops = save_unroll_flag;
++ 		     flag_unroll_all_loops = save_unroll_all_flag;
++ 
++ 		     loop_optimize (insns, loop_dump_file);
++ 		   }
+  	       });
+      }
+*************** rest_of_compilation (decl)
+*** 3280,3283 ****
+--- 3334,3341 ----
+    resume_temporary_allocation ();
+  
++   /* Show no temporary slots allocated.  */
++ 
++   init_temp_slots ();
++ 
+    /* The parsing time is all the time spent in yyparse
+       *except* what is spent in this function.  */
+*************** main (argc, argv, envp)
+*** 3383,3386 ****
+--- 3441,3445 ----
+        flag_omit_frame_pointer = 1;
+  #endif
++       flag_alias_check = 1;
+      }
+  
+diff -rcp2N gcc-2.7.2.2/tree.c g77-new/tree.c
+*** gcc-2.7.2.2/tree.c	Sun Oct  1 21:26:56 1995
+--- g77-new/tree.c	Sun Aug 10 18:47:23 1997
+*************** build_string (len, str)
+*** 1428,1436 ****
+  /* Return a newly constructed COMPLEX_CST node whose value is
+     specified by the real and imaginary parts REAL and IMAG.
+!    Both REAL and IMAG should be constant nodes.
+!    The TREE_TYPE is not initialized.  */
+  
+  tree
+! build_complex (real, imag)
+       tree real, imag;
+  {
+--- 1428,1437 ----
+  /* Return a newly constructed COMPLEX_CST node whose value is
+     specified by the real and imaginary parts REAL and IMAG.
+!    Both REAL and IMAG should be constant nodes.  TYPE, if specified,
+!    will be the type of the COMPLEX_CST; otherwise a new type will be made.  */
+  
+  tree
+! build_complex (type, real, imag)
+!      tree type;
+       tree real, imag;
+  {
+*************** build_complex (real, imag)
+*** 1439,1443 ****
+    TREE_REALPART (t) = real;
+    TREE_IMAGPART (t) = imag;
+!   TREE_TYPE (t) = build_complex_type (TREE_TYPE (real));
+    TREE_OVERFLOW (t) = TREE_OVERFLOW (real) | TREE_OVERFLOW (imag);
+    TREE_CONSTANT_OVERFLOW (t)
+--- 1440,1444 ----
+    TREE_REALPART (t) = real;
+    TREE_IMAGPART (t) = imag;
+!   TREE_TYPE (t) = type ? type : build_complex_type (TREE_TYPE (real));
+    TREE_OVERFLOW (t) = TREE_OVERFLOW (real) | TREE_OVERFLOW (imag);
+    TREE_CONSTANT_OVERFLOW (t)
+*************** integer_zerop (expr)
+*** 1484,1487 ****
+--- 1485,1489 ----
+  
+    return ((TREE_CODE (expr) == INTEGER_CST
++ 	   && ! TREE_CONSTANT_OVERFLOW (expr)
+  	   && TREE_INT_CST_LOW (expr) == 0
+  	   && TREE_INT_CST_HIGH (expr) == 0)
+*************** integer_onep (expr)
+*** 1501,1504 ****
+--- 1503,1507 ----
+  
+    return ((TREE_CODE (expr) == INTEGER_CST
++ 	   && ! TREE_CONSTANT_OVERFLOW (expr)
+  	   && TREE_INT_CST_LOW (expr) == 1
+  	   && TREE_INT_CST_HIGH (expr) == 0)
+*************** integer_all_onesp (expr)
+*** 1525,1529 ****
+      return 1;
+  
+!   else if (TREE_CODE (expr) != INTEGER_CST)
+      return 0;
+  
+--- 1528,1533 ----
+      return 1;
+  
+!   else if (TREE_CODE (expr) != INTEGER_CST
+! 	   || TREE_CONSTANT_OVERFLOW (expr))
+      return 0;
+  
+*************** integer_pow2p (expr)
+*** 1574,1578 ****
+      return 1;
+  
+!   if (TREE_CODE (expr) != INTEGER_CST)
+      return 0;
+  
+--- 1578,1582 ----
+      return 1;
+  
+!   if (TREE_CODE (expr) != INTEGER_CST || TREE_CONSTANT_OVERFLOW (expr))
+      return 0;
+  
+*************** real_zerop (expr)
+*** 1596,1599 ****
+--- 1600,1604 ----
+  
+    return ((TREE_CODE (expr) == REAL_CST
++ 	   && ! TREE_CONSTANT_OVERFLOW (expr)
+  	   && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst0))
+  	  || (TREE_CODE (expr) == COMPLEX_CST
+*************** real_onep (expr)
+*** 1611,1614 ****
+--- 1616,1620 ----
+  
+    return ((TREE_CODE (expr) == REAL_CST
++ 	   && ! TREE_CONSTANT_OVERFLOW (expr)
+  	   && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst1))
+  	  || (TREE_CODE (expr) == COMPLEX_CST
+*************** real_twop (expr)
+*** 1626,1629 ****
+--- 1632,1636 ----
+  
+    return ((TREE_CODE (expr) == REAL_CST
++ 	   && ! TREE_CONSTANT_OVERFLOW (expr)
+  	   && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst2))
+  	  || (TREE_CODE (expr) == COMPLEX_CST
+*************** staticp (arg)
+*** 2055,2061 ****
+        return 1;
+  
+      case COMPONENT_REF:
+      case BIT_FIELD_REF:
+!       return staticp (TREE_OPERAND (arg, 0));
+  
+  #if 0
+--- 2062,2073 ----
+        return 1;
+  
++       /* If we are referencing a bitfield, we can't evaluate an
++ 	 ADDR_EXPR at compile time and so it isn't a constant.  */
+      case COMPONENT_REF:
++       return (! DECL_BIT_FIELD (TREE_OPERAND (arg, 1))
++ 	      && staticp (TREE_OPERAND (arg, 0)));
++ 
+      case BIT_FIELD_REF:
+!       return 0;
+  
+  #if 0
+*************** contains_placeholder_p (exp)
+*** 2157,2160 ****
+--- 2169,2174 ----
+    if (code == WITH_RECORD_EXPR)
+      return 0;
++   else if (code == PLACEHOLDER_EXPR)
++     return 1;
+  
+    switch (TREE_CODE_CLASS (code))
+*************** substitute_in_expr (exp, f, r)
+*** 2204,2207 ****
+--- 2218,2222 ----
+  {
+    enum tree_code code = TREE_CODE (exp);
++   tree op0, op1, op2;
+    tree new = 0;
+    tree inner;
+*************** substitute_in_expr (exp, f, r)
+*** 2225,2231 ****
+  	{
+  	case 1:
+! 	  new = fold (build1 (code, TREE_TYPE (exp),
+! 			      substitute_in_expr (TREE_OPERAND (exp, 0),
+! 						  f, r)));
+  	  break;
+  
+--- 2240,2248 ----
+  	{
+  	case 1:
+! 	  op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
+! 	  if (op0 == TREE_OPERAND (exp, 0))
+! 	    return exp;
+! 	  
+! 	  new = fold (build1 (code, TREE_TYPE (exp), op0));
+  	  break;
+  
+*************** substitute_in_expr (exp, f, r)
+*** 2238,2245 ****
+  	    abort ();
+  
+! 	  new = fold (build (code, TREE_TYPE (exp),
+! 			     substitute_in_expr (TREE_OPERAND (exp, 0), f, r),
+! 			     substitute_in_expr (TREE_OPERAND (exp, 1),
+! 						 f, r)));
+  	  break;
+  
+--- 2255,2264 ----
+  	    abort ();
+  
+! 	  op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
+! 	  op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r);
+! 	  if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1))
+! 	    return exp;
+! 
+! 	  new = fold (build (code, TREE_TYPE (exp), op0, op1));
+  	  break;
+  
+*************** substitute_in_expr (exp, f, r)
+*** 2253,2261 ****
+  	    abort ();
+  
+! 	  new = fold (build (code, TREE_TYPE (exp),
+! 			     substitute_in_expr (TREE_OPERAND (exp, 0), f, r),
+! 			     substitute_in_expr (TREE_OPERAND (exp, 1), f, r),
+! 			     substitute_in_expr (TREE_OPERAND (exp, 2),
+! 						 f, r)));
+  	}
+  
+--- 2272,2283 ----
+  	    abort ();
+  
+! 	  op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
+! 	  op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r);
+! 	  op2 = substitute_in_expr (TREE_OPERAND (exp, 2), f, r);
+! 	  if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1)
+! 	      && op2 == TREE_OPERAND (exp, 2))
+! 	    return exp;
+! 
+! 	  new = fold (build (code, TREE_TYPE (exp), op0, op1, op2));
+  	}
+  
+*************** substitute_in_expr (exp, f, r)
+*** 2276,2302 ****
+  	    return r;
+  
+! 	  new = fold (build (code, TREE_TYPE (exp),
+! 			     substitute_in_expr (TREE_OPERAND (exp, 0), f, r),
+  			     TREE_OPERAND (exp, 1)));
+  	  break;
+  
+  	case BIT_FIELD_REF:
+! 	  new = fold (build (code, TREE_TYPE (exp),
+! 			     substitute_in_expr (TREE_OPERAND (exp, 0), f, r),
+! 			     substitute_in_expr (TREE_OPERAND (exp, 1), f, r),
+! 			     substitute_in_expr (TREE_OPERAND (exp, 2), f, r)));
+  	  break;
+  
+  	case INDIRECT_REF:
+  	case BUFFER_REF:
+! 	  new = fold (build1 (code, TREE_TYPE (exp),
+! 			      substitute_in_expr (TREE_OPERAND (exp, 0),
+! 						  f, r)));
+  	  break;
+  
+  	case OFFSET_REF:
+! 	  new = fold (build (code, TREE_TYPE (exp),
+! 			     substitute_in_expr (TREE_OPERAND (exp, 0), f, r),
+! 			     substitute_in_expr (TREE_OPERAND (exp, 1), f, r)));
+  	  break;
+  	}
+--- 2298,2342 ----
+  	    return r;
+  
+! 	  /* If this expression hasn't been completed let, leave it 
+! 	     alone.  */
+! 	  if (TREE_CODE (inner) == PLACEHOLDER_EXPR
+! 	      && TREE_TYPE (inner) == 0)
+! 	    return exp;
+! 
+! 	  op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
+! 	  if (op0 == TREE_OPERAND (exp, 0))
+! 	    return exp;
+! 
+! 	  new = fold (build (code, TREE_TYPE (exp), op0,
+  			     TREE_OPERAND (exp, 1)));
+  	  break;
+  
+  	case BIT_FIELD_REF:
+! 	  op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
+! 	  op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r);
+! 	  op2 = substitute_in_expr (TREE_OPERAND (exp, 2), f, r);
+! 	  if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1)
+! 	      && op2 == TREE_OPERAND (exp, 2))
+! 	    return exp;
+! 
+! 	  new = fold (build (code, TREE_TYPE (exp), op0, op1, op2));
+  	  break;
+  
+  	case INDIRECT_REF:
+  	case BUFFER_REF:
+! 	  op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
+! 	  if (op0 == TREE_OPERAND (exp, 0))
+! 	    return exp;
+! 
+! 	  new = fold (build1 (code, TREE_TYPE (exp), op0));
+  	  break;
+  
+  	case OFFSET_REF:
+! 	  op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
+! 	  op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r);
+! 	  if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1))
+! 	    return exp;
+! 
+! 	  new = fold (build (code, TREE_TYPE (exp), op0, op1));
+  	  break;
+  	}
+*************** substitute_in_expr (exp, f, r)
+*** 2311,2454 ****
+  }
+  
+- /* Given a type T, a FIELD_DECL F, and a replacement value R,
+-    return a new type with all size expressions that contain F
+-    updated by replacing F with R.  */
+- 
+- tree
+- substitute_in_type (t, f, r)
+-      tree t, f, r;
+- {
+-   switch (TREE_CODE (t))
+-     {
+-     case POINTER_TYPE:
+-     case VOID_TYPE:
+-       return t;
+-     case INTEGER_TYPE:
+-     case ENUMERAL_TYPE:
+-     case BOOLEAN_TYPE:
+-     case CHAR_TYPE:
+-       if ((TREE_CODE (TYPE_MIN_VALUE (t)) != INTEGER_CST
+- 	   && contains_placeholder_p (TYPE_MIN_VALUE (t)))
+- 	  || (TREE_CODE (TYPE_MAX_VALUE (t)) != INTEGER_CST
+- 	      && contains_placeholder_p (TYPE_MAX_VALUE (t))))
+- 	return build_range_type (t,
+- 				 substitute_in_expr (TYPE_MIN_VALUE (t), f, r),
+- 				 substitute_in_expr (TYPE_MAX_VALUE (t), f, r));
+-       return t;
+- 
+-     case REAL_TYPE:
+-       if ((TYPE_MIN_VALUE (t) != 0
+- 	   && TREE_CODE (TYPE_MIN_VALUE (t)) != REAL_CST
+- 	   && contains_placeholder_p (TYPE_MIN_VALUE (t)))
+- 	  || (TYPE_MAX_VALUE (t) != 0
+- 	      && TREE_CODE (TYPE_MAX_VALUE (t)) != REAL_CST
+- 	      && contains_placeholder_p (TYPE_MAX_VALUE (t))))
+- 	{
+- 	  t = build_type_copy (t);
+- 
+- 	  if (TYPE_MIN_VALUE (t))
+- 	    TYPE_MIN_VALUE (t) = substitute_in_expr (TYPE_MIN_VALUE (t), f, r);
+- 	  if (TYPE_MAX_VALUE (t))
+- 	    TYPE_MAX_VALUE (t) = substitute_in_expr (TYPE_MAX_VALUE (t), f, r);
+- 	}
+-       return t;
+- 
+-     case COMPLEX_TYPE:
+-       return build_complex_type (substitute_in_type (TREE_TYPE (t), f, r));
+- 
+-     case OFFSET_TYPE:
+-     case METHOD_TYPE:
+-     case REFERENCE_TYPE:
+-     case FILE_TYPE:
+-     case SET_TYPE:
+-     case FUNCTION_TYPE:
+-     case LANG_TYPE:
+-       /* Don't know how to do these yet.  */
+-       abort ();
+- 
+-     case ARRAY_TYPE:
+-       t = build_array_type (substitute_in_type (TREE_TYPE (t), f, r),
+- 			    substitute_in_type (TYPE_DOMAIN (t), f, r));
+-       TYPE_SIZE (t) = 0;
+-       layout_type (t);
+-       return t;
+- 
+-     case RECORD_TYPE:
+-     case UNION_TYPE:
+-     case QUAL_UNION_TYPE:
+-       {
+- 	tree new = copy_node (t);
+- 	tree field;
+- 	tree last_field = 0;
+- 
+- 	/* Start out with no fields, make new fields, and chain them
+- 	   in.  */
+- 
+- 	TYPE_FIELDS (new) = 0;
+- 	TYPE_SIZE (new) = 0;
+- 
+- 	for (field = TYPE_FIELDS (t); field;
+- 	     field = TREE_CHAIN (field))
+- 	  {
+- 	    tree new_field = copy_node (field);
+- 
+- 	    TREE_TYPE (new_field)
+- 	      = substitute_in_type (TREE_TYPE (new_field), f, r);
+- 
+- 	    /* If this is an anonymous field and the type of this field is
+- 	       a UNION_TYPE or RECORD_TYPE with no elements, ignore it.  If
+- 	       the type just has one element, treat that as the field. 
+- 	       But don't do this if we are processing a QUAL_UNION_TYPE.  */
+- 	    if (TREE_CODE (t) != QUAL_UNION_TYPE && DECL_NAME (new_field) == 0
+- 		&& (TREE_CODE (TREE_TYPE (new_field)) == UNION_TYPE
+- 		    || TREE_CODE (TREE_TYPE (new_field)) == RECORD_TYPE))
+- 	      {
+- 		if (TYPE_FIELDS (TREE_TYPE (new_field)) == 0)
+- 		  continue;
+- 
+- 		if (TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (new_field))) == 0)
+- 		  new_field = TYPE_FIELDS (TREE_TYPE (new_field));
+- 	      }
+- 
+- 	    DECL_CONTEXT (new_field) = new;
+- 	    DECL_SIZE (new_field) = 0;
+- 
+- 	    if (TREE_CODE (t) == QUAL_UNION_TYPE)
+- 	      {
+- 		/* Do the substitution inside the qualifier and if we find
+- 		   that this field will not be present, omit it.  */
+- 		DECL_QUALIFIER (new_field)
+- 		  = substitute_in_expr (DECL_QUALIFIER (field), f, r);
+- 		if (integer_zerop (DECL_QUALIFIER (new_field)))
+- 		  continue;
+- 	      }
+- 
+- 	    if (last_field == 0)
+- 	      TYPE_FIELDS (new) = new_field;
+- 	    else
+- 	      TREE_CHAIN (last_field) = new_field;
+- 
+- 	    last_field = new_field;
+- 
+- 	    /* If this is a qualified type and this field will always be
+- 	       present, we are done.  */
+- 	    if (TREE_CODE (t) == QUAL_UNION_TYPE
+- 		&& integer_onep (DECL_QUALIFIER (new_field)))
+- 	      break;
+- 	  }
+- 
+- 	/* If this used to be a qualified union type, but we now know what
+- 	   field will be present, make this a normal union.  */
+- 	if (TREE_CODE (new) == QUAL_UNION_TYPE
+- 	    && (TYPE_FIELDS (new) == 0
+- 		|| integer_onep (DECL_QUALIFIER (TYPE_FIELDS (new)))))
+- 	  TREE_SET_CODE (new, UNION_TYPE);
+- 
+- 	layout_type (new);
+- 	return new;
+-       }
+-     }
+- }
+- 
+  /* Stabilize a reference so that we can use it any number of times
+     without causing its operands to be evaluated more than once.
+--- 2351,2354 ----
+*************** build_type_variant (type, constp, volati
+*** 3141,3145 ****
+       preserve the TYPE_NAME, since there is code that depends on this.  */
+  
+!   for (t = TYPE_MAIN_VARIANT(type); t; t = TYPE_NEXT_VARIANT (t))
+      if (constp == TYPE_READONLY (t) && volatilep == TYPE_VOLATILE (t)
+  	&& TYPE_NAME (t) == TYPE_NAME (type))
+--- 3041,3045 ----
+       preserve the TYPE_NAME, since there is code that depends on this.  */
+  
+!   for (t = TYPE_MAIN_VARIANT (type); t; t = TYPE_NEXT_VARIANT (t))
+      if (constp == TYPE_READONLY (t) && volatilep == TYPE_VOLATILE (t)
+  	&& TYPE_NAME (t) == TYPE_NAME (type))
+*************** get_unwidened (op, for_type)
+*** 4051,4055 ****
+    if (TREE_CODE (op) == COMPONENT_REF
+        /* Since type_for_size always gives an integer type.  */
+!       && TREE_CODE (type) != REAL_TYPE)
+      {
+        unsigned innerprec = TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (op, 1)));
+--- 3951,3957 ----
+    if (TREE_CODE (op) == COMPONENT_REF
+        /* Since type_for_size always gives an integer type.  */
+!       && TREE_CODE (type) != REAL_TYPE
+!       /* Don't crash if field not layed out yet.  */
+!       && DECL_SIZE (TREE_OPERAND (op, 1)) != 0)
+      {
+        unsigned innerprec = TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (op, 1)));
+diff -rcp2N gcc-2.7.2.2/tree.h g77-new/tree.h
+*** gcc-2.7.2.2/tree.h	Mon Sep 25 17:49:40 1995
+--- g77-new/tree.h	Sun Aug 10 18:47:08 1997
+*************** enum built_in_function
+*** 98,101 ****
+--- 98,103 ----
+    BUILT_IN_APPLY,
+    BUILT_IN_RETURN,
++   BUILT_IN_SETJMP,
++   BUILT_IN_LONGJMP,
+  
+    /* C++ extensions */
+*************** struct tree_int_cst
+*** 408,411 ****
+--- 410,415 ----
+  {
+    char common[sizeof (struct tree_common)];
++   struct rtx_def *rtl;	/* acts as link to register transfer language
++ 			   (rtl) info */
+    HOST_WIDE_INT int_cst_low;
+    HOST_WIDE_INT int_cst_high;
+*************** struct tree_type
+*** 957,960 ****
+--- 961,967 ----
+  #define DECL_STATIC_DESTRUCTOR(NODE) ((NODE)->decl.static_dtor_flag)
+  
++ /* In a PARM_DECL, nonzero if this is a restricted pointer.  */
++ #define DECL_RESTRICT(NODE) (NODE)->decl.static_ctor_flag
++ 
+  /* Used to indicate that this DECL represents a compiler-generated entity.  */
+  #define DECL_ARTIFICIAL(NODE) ((NODE)->decl.artificial_flag)
+*************** extern tree build_int_2_wide		PROTO((HOS
+*** 1176,1180 ****
+  extern tree build_real			PROTO((tree, REAL_VALUE_TYPE));
+  extern tree build_real_from_int_cst 	PROTO((tree, tree));
+! extern tree build_complex		PROTO((tree, tree));
+  extern tree build_string		PROTO((int, char *));
+  extern tree build1			PROTO((enum tree_code, tree, tree));
+--- 1183,1187 ----
+  extern tree build_real			PROTO((tree, REAL_VALUE_TYPE));
+  extern tree build_real_from_int_cst 	PROTO((tree, tree));
+! extern tree build_complex		PROTO((tree, tree, tree));
+  extern tree build_string		PROTO((int, char *));
+  extern tree build1			PROTO((enum tree_code, tree, tree));
+*************** extern int contains_placeholder_p	PROTO(
+*** 1378,1387 ****
+  extern tree substitute_in_expr		PROTO((tree, tree, tree));
+  
+- /* Given a type T, a FIELD_DECL F, and a replacement value R,
+-    return a new type with all size expressions that contain F
+-    updated by replacing the reference to F with R.  */
+- 
+- extern tree substitute_in_type		PROTO((tree, tree, tree));
+- 
+  /* variable_size (EXP) is like save_expr (EXP) except that it
+     is for the special case of something that is part of a
+--- 1385,1388 ----
+*************** extern tree maybe_build_cleanup		PROTO((
+*** 1456,1460 ****
+     and find the ultimate containing object, which is returned.  */
+  
+! extern tree get_inner_reference		PROTO((tree, int *, int *, tree *, enum machine_mode *, int *, int *));
+  
+  /* Return the FUNCTION_DECL which provides this _DECL with its context,
+--- 1457,1463 ----
+     and find the ultimate containing object, which is returned.  */
+  
+! extern tree get_inner_reference		PROTO((tree, int *, int *, tree *,
+! 					       enum machine_mode *, int *,
+! 					       int *, int *));
+  
+  /* Return the FUNCTION_DECL which provides this _DECL with its context,
+diff -rcp2N gcc-2.7.2.2/unroll.c g77-new/unroll.c
+*** gcc-2.7.2.2/unroll.c	Sat Aug 19 17:33:26 1995
+--- g77-new/unroll.c	Thu Jul 10 20:09:10 1997
+*************** unroll_loop (loop_end, insn_count, loop_
+*** 268,273 ****
+       structure of the function.  This can happen as a result of the
+       "if (foo) bar; else break;" optimization in jump.c.  */
+  
+!   if (write_symbols != NO_DEBUG)
+      {
+        int block_begins = 0;
+--- 268,277 ----
+       structure of the function.  This can happen as a result of the
+       "if (foo) bar; else break;" optimization in jump.c.  */
++   /* ??? Gcc has a general policy that -g is never supposed to change the code
++      that the compiler emits, so we must disable this optimization always,
++      even if debug info is not being output.  This is rare, so this should
++      not be a significant performance problem.  */
+  
+!   if (1 /* write_symbols != NO_DEBUG */)
+      {
+        int block_begins = 0;
+*************** unroll_loop (loop_end, insn_count, loop_
+*** 633,636 ****
+--- 637,657 ----
+      }
+  
++   if (unroll_type == UNROLL_NAIVE
++       && GET_CODE (last_loop_insn) == JUMP_INSN
++       && start_label != JUMP_LABEL (last_loop_insn))
++     {
++       /* ??? The loop ends with a conditional branch that does not branch back
++ 	 to the loop start label.  In this case, we must emit an unconditional
++ 	 branch to the loop exit after emitting the final branch.
++ 	 copy_loop_body does not have support for this currently, so we
++ 	 give up.  It doesn't seem worthwhile to unroll anyways since
++ 	 unrolling would increase the number of branch instructions
++ 	 executed.  */
++       if (loop_dump_stream)
++ 	fprintf (loop_dump_stream,
++ 		 "Unrolling failure: final conditional branch not to loop start\n");
++       return;
++     }
++ 
+    /* Allocate a translation table for the labels and insn numbers.
+       They will be filled in as we copy the insns in the loop.  */
+*************** unroll_loop (loop_end, insn_count, loop_
+*** 995,999 ****
+  	      for (j = FIRST_PSEUDO_REGISTER; j < max_reg_before_loop; j++)
+  		if (local_regno[j])
+! 		  map->reg_map[j] = gen_reg_rtx (GET_MODE (regno_reg_rtx[j]));
+  
+  	      /* The last copy needs the compare/branch insns at the end,
+--- 1016,1024 ----
+  	      for (j = FIRST_PSEUDO_REGISTER; j < max_reg_before_loop; j++)
+  		if (local_regno[j])
+! 		  {
+! 		    map->reg_map[j] = gen_reg_rtx (GET_MODE (regno_reg_rtx[j]));
+! 		    record_base_value (REGNO (map->reg_map[j]),
+! 				       regno_reg_rtx[j]);
+! 		  }
+  
+  	      /* The last copy needs the compare/branch insns at the end,
+*************** unroll_loop (loop_end, insn_count, loop_
+*** 1136,1140 ****
+        for (j = FIRST_PSEUDO_REGISTER; j < max_reg_before_loop; j++)
+  	if (local_regno[j])
+! 	  map->reg_map[j] = gen_reg_rtx (GET_MODE (regno_reg_rtx[j]));
+  
+        /* If loop starts with a branch to the test, then fix it so that
+--- 1161,1169 ----
+        for (j = FIRST_PSEUDO_REGISTER; j < max_reg_before_loop; j++)
+  	if (local_regno[j])
+! 	  {
+! 	    map->reg_map[j] = gen_reg_rtx (GET_MODE (regno_reg_rtx[j]));
+! 	    record_base_value (REGNO (map->reg_map[j]),
+! 			       regno_reg_rtx[j]);
+! 	  }
+  
+        /* If loop starts with a branch to the test, then fix it so that
+*************** copy_loop_body (copy_start, copy_end, ma
+*** 1605,1608 ****
+--- 1634,1641 ----
+  		    int this_giv_inc = INTVAL (giv_inc);
+  
++ 		    /* If this DEST_ADDR giv was not split, then ignore it.  */
++ 		    if (*tv->location != tv->dest_reg)
++ 		      continue;
++ 
+  		    /* Scale this_giv_inc if the multiplicative factors of
+  		       the two givs are different.  */
+*************** copy_loop_body (copy_start, copy_end, ma
+*** 1631,1635 ****
+  			   incrementing the shared pseudo reg more than
+  			   once.  */
+! 			if (! tv->same_insn)
+  			  {
+  			    /* tv->dest_reg may actually be a (PLUS (REG)
+--- 1664,1668 ----
+  			   incrementing the shared pseudo reg more than
+  			   once.  */
+! 			if (! tv->same_insn && ! tv->shared)
+  			  {
+  			    /* tv->dest_reg may actually be a (PLUS (REG)
+*************** copy_loop_body (copy_start, copy_end, ma
+*** 1757,1760 ****
+--- 1790,1794 ----
+  		      giv_dest_reg = tem;
+  		      map->reg_map[regno] = tem;
++ 		      record_base_value (REGNO (tem), giv_src_reg);
+  		    }
+  		  else
+*************** iteration_info (iteration_var, initial_v
+*** 2220,2231 ****
+        return;
+      }
+!   /* Reject iteration variables larger than the host long size, since they
+       could result in a number of iterations greater than the range of our
+!      `unsigned long' variable loop_n_iterations.  */
+!   else if (GET_MODE_BITSIZE (GET_MODE (iteration_var)) > HOST_BITS_PER_LONG)
+      {
+        if (loop_dump_stream)
+  	fprintf (loop_dump_stream,
+! 		 "Loop unrolling: Iteration var rejected because mode larger than host long.\n");
+        return;
+      }
+--- 2254,2266 ----
+        return;
+      }
+!   /* Reject iteration variables larger than the host wide int size, since they
+       could result in a number of iterations greater than the range of our
+!      `unsigned HOST_WIDE_INT' variable loop_n_iterations.  */
+!   else if ((GET_MODE_BITSIZE (GET_MODE (iteration_var))
+! 	    > HOST_BITS_PER_WIDE_INT))
+      {
+        if (loop_dump_stream)
+  	fprintf (loop_dump_stream,
+! 		 "Loop unrolling: Iteration var rejected because mode too large.\n");
+        return;
+      }
+*************** find_splittable_regs (unroll_type, loop_
+*** 2443,2447 ****
+  		{
+  		  rtx tem = gen_reg_rtx (bl->biv->mode);
+! 		  
+  		  emit_insn_before (gen_move_insn (tem, bl->biv->src_reg),
+  				    loop_start);
+--- 2478,2483 ----
+  		{
+  		  rtx tem = gen_reg_rtx (bl->biv->mode);
+! 
+! 		  record_base_value (REGNO (tem), bl->biv->add_val);
+  		  emit_insn_before (gen_move_insn (tem, bl->biv->src_reg),
+  				    loop_start);
+*************** find_splittable_regs (unroll_type, loop_
+*** 2500,2503 ****
+--- 2536,2541 ----
+  		 exits.  */
+  	      rtx tem = gen_reg_rtx (bl->biv->mode);
++ 	      record_base_value (REGNO (tem), bl->biv->add_val);
++ 
+  	      emit_insn_before (gen_move_insn (tem, bl->biv->src_reg),
+  				loop_start);
+*************** find_splittable_givs (bl, unroll_type, l
+*** 2675,2678 ****
+--- 2713,2717 ----
+  	      rtx tem = gen_reg_rtx (bl->biv->mode);
+  
++ 	      record_base_value (REGNO (tem), bl->biv->add_val);
+  	      emit_insn_before (gen_move_insn (tem, bl->biv->src_reg),
+  				loop_start);
+*************** find_splittable_givs (bl, unroll_type, l
+*** 2716,2719 ****
+--- 2755,2759 ----
+  		{
+  		  rtx tem = gen_reg_rtx (v->mode);
++ 		  record_base_value (REGNO (tem), v->add_val);
+  		  emit_iv_add_mult (bl->initial_value, v->mult_val,
+  				    v->add_val, tem, loop_start);
+*************** find_splittable_givs (bl, unroll_type, l
+*** 2734,2747 ****
+  		 register for the split addr giv, just to be safe.  */
+  
+! 	      /* ??? If there are multiple address givs which have been
+! 		 combined with the same dest_reg giv, then we may only need
+! 		 one new register for them.  Pulling out constants below will
+! 		 catch some of the common cases of this.  Currently, I leave
+! 		 the work of simplifying multiple address givs to the
+! 		 following cse pass.  */
+! 	      
+! 	      /* As a special case, if we have multiple identical address givs
+! 		 within a single instruction, then we do use a single pseudo
+! 		 reg for both.  This is necessary in case one is a match_dup
+  		 of the other.  */
+  
+--- 2774,2780 ----
+  		 register for the split addr giv, just to be safe.  */
+  
+! 	      /* If we have multiple identical address givs within a
+! 		 single instruction, then use a single pseudo reg for
+! 		 both.  This is necessary in case one is a match_dup
+  		 of the other.  */
+  
+*************** find_splittable_givs (bl, unroll_type, l
+*** 2756,2759 ****
+--- 2789,2812 ----
+  			     INSN_UID (v->insn));
+  		}
++ 	      /* If multiple address GIVs have been combined with the
++ 		 same dest_reg GIV, do not create a new register for
++ 		 each.  */
++ 	      else if (unroll_type != UNROLL_COMPLETELY
++ 		       && v->giv_type == DEST_ADDR
++ 		       && v->same && v->same->giv_type == DEST_ADDR
++ 		       && v->same->unrolled
++ #ifdef ADDRESS_COST
++ 		       /* combine_givs_p may return true when ADDRESS_COST is
++ 			  defined even if the multiply and add values are
++ 			  not equal.  To share a register here, the values
++ 			  must be equal, as well as related.  */
++ 		       && rtx_equal_p (v->mult_val, v->same->mult_val)
++ 		       && rtx_equal_p (v->add_val, v->same->add_val)
++ #endif
++ 		       )
++ 		{
++ 		  v->dest_reg = v->same->dest_reg;
++ 		  v->shared = 1;
++ 		}
+  	      else if (unroll_type != UNROLL_COMPLETELY)
+  		{
+*************** find_splittable_givs (bl, unroll_type, l
+*** 2761,2765 ****
+  		     register to hold the split value of the DEST_ADDR giv.
+  		     Emit insn to initialize its value before loop start.  */
+! 		  tem = gen_reg_rtx (v->mode);
+  
+  		  /* If the address giv has a constant in its new_reg value,
+--- 2814,2821 ----
+  		     register to hold the split value of the DEST_ADDR giv.
+  		     Emit insn to initialize its value before loop start.  */
+! 
+! 		  rtx tem = gen_reg_rtx (v->mode);
+! 		  record_base_value (REGNO (tem), v->add_val);
+! 		  v->unrolled = 1;
+  
+  		  /* If the address giv has a constant in its new_reg value,
+*************** find_splittable_givs (bl, unroll_type, l
+*** 2772,2781 ****
+  		      v->dest_reg
+  			= plus_constant (tem, INTVAL (XEXP (v->new_reg,1)));
+! 		      
+  		      /* Only succeed if this will give valid addresses.
+  			 Try to validate both the first and the last
+  			 address resulting from loop unrolling, if
+  			 one fails, then can't do const elim here.  */
+! 		      if (! verify_addresses (v, giv_inc, unroll_number))
+  			{
+  			  /* Save the negative of the eliminated const, so
+--- 2828,2837 ----
+  		      v->dest_reg
+  			= plus_constant (tem, INTVAL (XEXP (v->new_reg,1)));
+! 
+  		      /* Only succeed if this will give valid addresses.
+  			 Try to validate both the first and the last
+  			 address resulting from loop unrolling, if
+  			 one fails, then can't do const elim here.  */
+! 		      if (verify_addresses (v, giv_inc, unroll_number))
+  			{
+  			  /* Save the negative of the eliminated const, so
+*************** final_biv_value (bl, loop_start, loop_en
+*** 3061,3064 ****
+--- 3117,3121 ----
+  
+  	  tem = gen_reg_rtx (bl->biv->mode);
++ 	  record_base_value (REGNO (tem), bl->biv->add_val);
+  	  /* Make sure loop_end is not the last insn.  */
+  	  if (NEXT_INSN (loop_end) == 0)
+*************** final_giv_value (v, loop_start, loop_end
+*** 3154,3157 ****
+--- 3211,3215 ----
+  	  /* Put the final biv value in tem.  */
+  	  tem = gen_reg_rtx (bl->biv->mode);
++ 	  record_base_value (REGNO (tem), bl->biv->add_val);
+  	  emit_iv_add_mult (increment, GEN_INT (loop_n_iterations),
+  			    bl->initial_value, tem, insert_before);
+diff -rcp2N gcc-2.7.2.2/varasm.c g77-new/varasm.c
+*** gcc-2.7.2.2/varasm.c	Thu Aug 31 19:02:53 1995
+--- g77-new/varasm.c	Sun Aug 10 22:26:32 1997
+*************** assemble_variable (decl, top_level, at_e
+*** 1067,1070 ****
+--- 1067,1072 ----
+    if (! dont_output_data)
+      {
++       int size;
++ 
+        if (TREE_CODE (DECL_SIZE (decl)) != INTEGER_CST)
+  	goto finish;
+*************** assemble_variable (decl, top_level, at_e
+*** 1072,1078 ****
+        /* This is better than explicit arithmetic, since it avoids overflow.  */
+        size_tree = size_binop (CEIL_DIV_EXPR,
+! 			  DECL_SIZE (decl), size_int (BITS_PER_UNIT));
+  
+!       if (TREE_INT_CST_HIGH (size_tree) != 0)
+  	{
+  	  error_with_decl (decl, "size of variable `%s' is too large");
+--- 1074,1082 ----
+        /* This is better than explicit arithmetic, since it avoids overflow.  */
+        size_tree = size_binop (CEIL_DIV_EXPR,
+! 			      DECL_SIZE (decl), size_int (BITS_PER_UNIT));
+  
+!       size = TREE_INT_CST_LOW (size_tree);
+!       if (TREE_INT_CST_HIGH (size_tree) != 0
+! 	  || size != TREE_INT_CST_LOW (size_tree))
+  	{
+  	  error_with_decl (decl, "size of variable `%s' is too large");
+*************** decode_addr_const (exp, value)
+*** 2132,2135 ****
+--- 2136,2140 ----
+      case COMPLEX_CST:
+      case CONSTRUCTOR:
++     case INTEGER_CST:
+        x = TREE_CST_RTL (target);
+        break;
+*************** const_hash (exp)
+*** 2247,2251 ****
+      return const_hash (TREE_OPERAND (exp, 0)) * 9
+        +  const_hash (TREE_OPERAND (exp, 1));
+!   else if (code == NOP_EXPR || code == CONVERT_EXPR)
+      return const_hash (TREE_OPERAND (exp, 0)) * 7 + 2;
+  
+--- 2252,2256 ----
+      return const_hash (TREE_OPERAND (exp, 0)) * 9
+        +  const_hash (TREE_OPERAND (exp, 1));
+!   else if (code == NOP_EXPR || code == CONVERT_EXPR || code == NON_LVALUE_EXPR)
+      return const_hash (TREE_OPERAND (exp, 0)) * 7 + 2;
+  
+*************** compare_constant_1 (exp, p)
+*** 2401,2405 ****
+        return p;
+      }
+!   else if (code == NOP_EXPR || code == CONVERT_EXPR)
+      {
+        p = compare_constant_1 (TREE_OPERAND (exp, 0), p);
+--- 2406,2410 ----
+        return p;
+      }
+!   else if (code == NOP_EXPR || code == CONVERT_EXPR || code == NON_LVALUE_EXPR)
+      {
+        p = compare_constant_1 (TREE_OPERAND (exp, 0), p);
+*************** copy_constant (exp)
+*** 2633,2637 ****
+  
+      case COMPLEX_CST:
+!       return build_complex (copy_constant (TREE_REALPART (exp)),
+  			    copy_constant (TREE_IMAGPART (exp)));
+  
+--- 2638,2643 ----
+  
+      case COMPLEX_CST:
+!       return build_complex (TREE_TYPE (exp),
+! 			    copy_constant (TREE_REALPART (exp)),
+  			    copy_constant (TREE_IMAGPART (exp)));
+  
+*************** copy_constant (exp)
+*** 2644,2647 ****
+--- 2650,2654 ----
+      case NOP_EXPR:
+      case CONVERT_EXPR:
++     case NON_LVALUE_EXPR:
+        return build1 (TREE_CODE (exp), TREE_TYPE (exp),
+  		     copy_constant (TREE_OPERAND (exp, 0)));
+*************** output_constant_def (exp)
+*** 2690,2696 ****
+    register rtx def;
+  
+-   if (TREE_CODE (exp) == INTEGER_CST)
+-     abort ();			/* No TREE_CST_RTL slot in these.  */
+- 
+    if (TREE_CST_RTL (exp))
+      return TREE_CST_RTL (exp);
+--- 2697,2700 ----
+*************** bc_assemble_integer (exp, size)
+*** 3620,3624 ****
+    exp = fold (exp);
+    
+!   while (TREE_CODE (exp) == NOP_EXPR || TREE_CODE (exp) == CONVERT_EXPR)
+      exp = TREE_OPERAND (exp, 0);
+    if (TREE_CODE (exp) == INTEGER_CST)
+--- 3624,3629 ----
+    exp = fold (exp);
+    
+!   while (TREE_CODE (exp) == NOP_EXPR || TREE_CODE (exp) == CONVERT_EXPR
+! 	 || TREE_CODE (exp) == NON_LVALUE_EXPR)
+      exp = TREE_OPERAND (exp, 0);
+    if (TREE_CODE (exp) == INTEGER_CST)
+*************** bc_assemble_integer (exp, size)
+*** 3631,3639 ****
+        const_part = TREE_OPERAND (exp, 0);
+        while (TREE_CODE (const_part) == NOP_EXPR
+! 	     || TREE_CODE (const_part) == CONVERT_EXPR)
+  	const_part = TREE_OPERAND (const_part, 0);
+        addr_part = TREE_OPERAND (exp, 1);
+        while (TREE_CODE (addr_part) == NOP_EXPR
+! 	     || TREE_CODE (addr_part) == CONVERT_EXPR)
+  	addr_part = TREE_OPERAND (addr_part, 0);
+        if (TREE_CODE (const_part) != INTEGER_CST)
+--- 3636,3646 ----
+        const_part = TREE_OPERAND (exp, 0);
+        while (TREE_CODE (const_part) == NOP_EXPR
+! 	     || TREE_CODE (const_part) == CONVERT_EXPR
+! 	     || TREE_CODE (const_part) == NON_LVALUE_EXPR)
+  	const_part = TREE_OPERAND (const_part, 0);
+        addr_part = TREE_OPERAND (exp, 1);
+        while (TREE_CODE (addr_part) == NOP_EXPR
+! 	     || TREE_CODE (addr_part) == CONVERT_EXPR
+! 	     || TREE_CODE (addr_part) == NON_LVALUE_EXPR)
+  	addr_part = TREE_OPERAND (addr_part, 0);
+        if (TREE_CODE (const_part) != INTEGER_CST)
+diff -rcp2N gcc-2.7.2.2/version.c g77-new/version.c
+*** gcc-2.7.2.2/version.c	Thu Feb 20 19:24:33 1997
+--- g77-new/version.c	Sun Aug 10 19:28:55 1997
+***************
+*** 1 ****
+! char *version_string = "2.7.2.2";
+--- 1 ----
+! char *version_string = "2.7.2.2.f.3b";
diff --git a/gcc/f/gbe/README b/gcc/f/gbe/README
new file mode 100644
index 00000000000..f03069048da
--- /dev/null
+++ b/gcc/f/gbe/README
@@ -0,0 +1,45 @@
+970811
+
+This directory contains .diff files for various GNU CC distributions
+supported by this version of GNU Fortran.
+
+The name of a file includes which gcc version to which it applies.
+For example, 2.7.2.2.diff is the patch file for gcc version 2.7.2.2.
+
+To apply a .diff file to, say, gcc 2.7.2.2, one might use the following
+command (where the current directory contains the gcc source distribution
+after merging into it the g77 source distribution, which would be
+named gcc-2.7.2.2 in this example):
+
+    patch -p1 -d gcc-2.7.2.2 < gcc-2.7.2.2/f/gbe/2.7.2.2.diff
+
+
+This version of g77 is best combined with gcc versions 2.7.2.2.
+
+However, note that applying any of these patches does _not_ update
+the gcc.info* files that constitute the Info documentation for gcc.
+Therefore, after applying the patch, you must rebuild the Info
+documentation yourself via:
+
+  cd gcc; make -f Makefile.in gcc.info
+
+If the above command doesn't work because you don't have makeinfo
+installed, you are STRONGLY encouraged to obtain the most recent
+version of the GNU texinfo package (texinfo-3.11.tar.gz as of this
+writing), build, and install it, then try the above command (as
+makeinfo is part of texinfo).
+
+This distribution of g77 is not supported for versions of gcc prior
+to 2.7.2.2.
+
+If you are using a version of gcc more recent than the most
+recent .diff file's version, try the most recent .diff ONLY
+if the difference is in the third field.  E.g. the above
+patch might work on gcc-2.7.3 or gcc-2.7.4 if these were
+released.  On the other hand, it probably wouldn't work for
+a more major release like gcc-2.8.0 or gcc-3.0.0, and you
+shouldn't try it.  If the .diff file is missing, don't bother
+asking <fortran@gnu.ai.mit.edu> for it -- it is certainly
+being worked on.  In the meantime, watch our progress at
+<ftp://alpha.gnu.ai.mit.edu/g77.plan> for information on support
+for the recent versions of gcc.
diff --git a/gcc/f/glimits.j b/gcc/f/glimits.j
new file mode 100644
index 00000000000..9a30bdbfba1
--- /dev/null
+++ b/gcc/f/glimits.j
@@ -0,0 +1,28 @@
+/* glimits.j -- Wrapper for GCC's glimits.h
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 MAKING_DEPENDENCIES
+#if !USE_HOST_LIMITS
+#include "glimits.h"
+#else
+#include <limits.h>
+#endif
+#endif
diff --git a/gcc/f/global.c b/gcc/f/global.c
new file mode 100644
index 00000000000..033448deaa4
--- /dev/null
+++ b/gcc/f/global.c
@@ -0,0 +1,1490 @@
+/* global.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 char *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) ())
+{
+  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 = (ffeglobal) malloc_new_ks (malloc_pool_image (), "FFEGLOBAL",
+				 sizeof (*g));
+  g->n = n;
+#ifdef FFECOM_globalHOOK
+  g->hook = FFECOM_globalNULL;
+#endif
+  g->tick = 0;
+
+  ffename_set_global (n, g);
+
+  return g;
+}
+
+#endif
+/* ffeglobal_init_1 -- Initialize per file
+
+   ffeglobal_init_1();	*/
+
+void
+ffeglobal_init_1 ()
+{
+#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)
+	{
+	  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)
+	{
+	  assert (g->u.common.blank == blank);
+	}
+      else
+	{
+	  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 ())
+	{
+	  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_typeNONE)
+      && (g->type != FFEGLOBAL_typeEXT)
+      && ((g->type != type)
+	  || (g->u.proc.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 = 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)
+	       && ((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))))
+	{
+	  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 ())
+	{
+	  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);
+	}
+      g->tick = ffe_count_2;
+      if ((g->tick != 0)
+	  && (g->type != type))
+	g->u.proc.n_args = -1;
+      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);
+    }
+  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 ();
+	}
+    }
+#endif
+
+  if (pad != 0)
+    {				/* Warn about initial padding in common area. */
+      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 ();
+    }
+}
+
+/* Collect info for a global's argument.  */
+
+void
+ffeglobal_proc_def_arg (ffesymbol s, int argno, 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 ())
+    {
+      char *refwhy = NULL;
+      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;
+
+	    case FFEGLOBAL_argsummaryPTR:
+	      defwhy = "a pointer";
+	      break;
+
+	    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
+    = (ffeglobalArgInfo_) 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)
+    {
+      char *refwhy = NULL;
+      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;
+
+	case FFEGLOBAL_argsummaryPTR:
+	  if ((ai->as != FFEGLOBAL_argsummaryPTR)
+	      && (ai->as != FFEGLOBAL_argsummaryNONE))
+	    {
+	      fail = TRUE;
+	      refwhy = "a pointer";
+	    }
+	  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;
+
+	    case FFEGLOBAL_argsummaryPTR:
+	      defwhy = "a pointer";
+	      break;
+
+	    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
+    = (ffeglobalArgInfo_) 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 ())
+	{
+	  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 ())
+	{
+	  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;
+
+  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 != type)
+      && (g->type != FFEGLOBAL_typeEXT)
+      && (type != FFEGLOBAL_typeEXT))
+    {
+      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 ())
+	    {
+	      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
+	  /* It is never really _known_ that an EXTERNAL statement
+	     names a BLOCK DATA by just looking at the program unit,
+	     so don't override a different notion.  */
+	  if (type == FFEGLOBAL_typeBDATA)
+	    type = FFEGLOBAL_typeEXT;
+	}
+      else if (ffe_is_globals ())
+	{
+	  ffebad_start (FFEBAD_FILEWIDE_DISAGREEMENT);
+	  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 FALSE;
+	}
+      else if (ffe_is_warn_globals ())
+	{
+	  ffebad_start (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 TRUE;
+	}
+    }
+
+  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);
+	}
+      /* Else, make sure there is type agreement.  */
+      else if ((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)
+		   || ((ffesymbol_size (s) != g->u.proc.sz)
+		       && (g->u.proc.sz != FFETARGET_charactersizeNONE))))
+	{
+	  if (ffe_is_globals ())
+	    {
+	      ffebad_start (FFEBAD_FILEWIDE_TYPE_MISMATCH);
+	      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 FALSE;
+	    }
+	  if (ffe_is_warn_globals ())
+	    {
+	      ffebad_start (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 TRUE;
+	}
+    }
+
+  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 ())
+    {
+      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->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
+   long 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, long 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->u.common.size < size) && (g->tick > 0) && (g->tick < ffe_count_2))
+    {
+      char oldsize[40];
+      char newsize[40];
+
+      sprintf (&oldsize[0], "%ld", g->u.common.size);
+      sprintf (&newsize[0], "%ld", 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], "%ld", g->u.common.size);
+      sprintf (&newsize[0], "%ld", 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 ()
+{
+}
diff --git a/gcc/f/global.h b/gcc/f/global.h
new file mode 100644
index 00000000000..fe0be038d21
--- /dev/null
+++ b/gcc/f/global.h
@@ -0,0 +1,201 @@
+/* global.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_global
+#define _H_f_global
+
+/* 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_argsummaryPTR,	/* Pointer (%LOC, LOC()). */
+    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;
+#ifdef FFECOM_globalHOOK
+  ffecomGlobal hook;
+#endif
+  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? */
+      long 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) ());
+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, 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, long size);
+void ffeglobal_terminate_1 (void);
+
+/* Define macros. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+#define FFEGLOBAL_ENABLED 0
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#define FFEGLOBAL_ENABLED 1
+#else
+#error
+#endif
+
+#define ffeglobal_common_init(g) ((g)->tick != 0)
+#define ffeglobal_common_have_pad(g) ((g)->u.common.have_pad)
+#define ffeglobal_common_have_size(g) ((g)->u.common.have_size)
+#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_pad(g) ((g)->pad)
+#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
diff --git a/gcc/f/hconfig.j b/gcc/f/hconfig.j
new file mode 100644
index 00000000000..b777b68b92d
--- /dev/null
+++ b/gcc/f/hconfig.j
@@ -0,0 +1,27 @@
+/* hconfig.j -- Wrapper for GCC's hconfig.h
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 MAKING_DEPENDENCIES
+#ifndef _J_f_hconfig
+#define _J_f_hconfig
+#include "hconfig.h"
+#endif
+#endif
diff --git a/gcc/f/implic.c b/gcc/f/implic.c
new file mode 100644
index 00000000000..292f88f7410
--- /dev/null
+++ b/gcc/f/implic.c
@@ -0,0 +1,383 @@
+/* implic.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 <ctype.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_ (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_ (char c)
+{
+  /* NOTE: This is definitely ASCII-specific!!  */
+  if (isalpha (c) || (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 ())
+    {
+      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 ()
+{
+  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 ()
+{
+  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;
+   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, 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 ()
+{
+}
diff --git a/gcc/f/implic.h b/gcc/f/implic.h
new file mode 100644
index 00000000000..2c03ab2cde1
--- /dev/null
+++ b/gcc/f/implic.h
@@ -0,0 +1,74 @@
+/* implic.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_implic
+#define _H_f_implic
+
+/* 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, 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
diff --git a/gcc/f/info-b.def b/gcc/f/info-b.def
new file mode 100644
index 00000000000..0084f7afc99
--- /dev/null
+++ b/gcc/f/info-b.def
@@ -0,0 +1,36 @@
+/* info-b.def -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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
new file mode 100644
index 00000000000..46e32b27e50
--- /dev/null
+++ b/gcc/f/info-k.def
@@ -0,0 +1,37 @@
+/* info-k.def -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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_KIND (FFEINFO_kindNONE, "an unknown kind", "")
+FFEINFO_KIND (FFEINFO_kindENTITY, "an entity", "e")
+FFEINFO_KIND (FFEINFO_kindFUNCTION, "a function", "f")
+FFEINFO_KIND (FFEINFO_kindSUBROUTINE, "a subroutine", "u")
+FFEINFO_KIND (FFEINFO_kindPROGRAM, "a program", "p")
+FFEINFO_KIND (FFEINFO_kindBLOCKDATA, "a block-data unit", "b")
+FFEINFO_KIND (FFEINFO_kindCOMMON, "a common block", "c")
+FFEINFO_KIND (FFEINFO_kindCONSTRUCT, "a construct", ":")
+FFEINFO_KIND (FFEINFO_kindNAMELIST, "a namelist", "n")
+FFEINFO_KIND (FFEINFO_kindANY, "anything", "~")
diff --git a/gcc/f/info-w.def b/gcc/f/info-w.def
new file mode 100644
index 00000000000..14e8a583a68
--- /dev/null
+++ b/gcc/f/info-w.def
@@ -0,0 +1,41 @@
+/* info-w.def -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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
new file mode 100644
index 00000000000..7c1ca9b0155
--- /dev/null
+++ b/gcc/f/info.c
@@ -0,0 +1,305 @@
+/* info.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 char *ffeinfo_basictype_string_[]
+=
+{
+#define FFEINFO_BASICTYPE(KWD,LNAM,SNAM) SNAM,
+#include "info-b.def"
+#undef FFEINFO_BASICTYPE
+};
+static char *ffeinfo_kind_message_[]
+=
+{
+#define FFEINFO_KIND(KWD,LNAM,SNAM) LNAM,
+#include "info-k.def"
+#undef FFEINFO_KIND
+};
+static char *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 char *ffeinfo_kindtype_string_[]
+=
+{
+  "",
+  "1",
+  "2",
+  "3",
+  "4",
+  "5",
+  "6",
+  "7",
+  "8",
+  "*",
+};
+static char *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]
+  = { { NULL } };
+
+/* 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.	*/
+
+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 ()
+{
+  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.  */
+
+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.  */
+
+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.  */
+
+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);
+  assert (ffeinfo_types_[basictype][kindtype] != NULL);
+
+  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.  */
+
+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
new file mode 100644
index 00000000000..33f1aa9e61e
--- /dev/null
+++ b/gcc/f/info.h
@@ -0,0 +1,186 @@
+/* info.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_info
+#define _H_f_info
+
+/* 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);
+char *ffeinfo_basictype_string (ffeinfoBasictype basictype);
+void ffeinfo_init_0 (void);
+char *ffeinfo_kind_message (ffeinfoKind kind);
+char *ffeinfo_kind_string (ffeinfoKind kind);
+ffeinfoKindtype ffeinfo_kindtype_max(ffeinfoBasictype bt,
+				     ffeinfoKindtype k1,
+				     ffeinfoKindtype k2);
+char *ffeinfo_kindtype_string (ffeinfoKindtype kind_type);
+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
diff --git a/gcc/f/input.j b/gcc/f/input.j
new file mode 100644
index 00000000000..c7ec5b690ff
--- /dev/null
+++ b/gcc/f/input.j
@@ -0,0 +1,27 @@
+/* input.j -- Wrapper for GCC's input.h
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 MAKING_DEPENDENCIES
+#ifndef _J_f_input
+#define _J_f_input
+#include "input.h"
+#endif
+#endif
diff --git a/gcc/f/install.texi b/gcc/f/install.texi
new file mode 100644
index 00000000000..f6f403ddfdd
--- /dev/null
+++ b/gcc/f/install.texi
@@ -0,0 +1,2036 @@
+@c Copyright (C) 1995-1997 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 INSTALL
+@c in the G77 distribution, as well as in the G77 manual.
+
+@c 1997-08-11
+
+@ifclear INSTALLONLY
+@node Installation
+@chapter Installing GNU Fortran
+@end ifclear
+@cindex installing GNU Fortran
+
+The following information describes how to install @code{g77}.
+
+The information in this file generally pertains to dealing
+with @emph{source} distributions of @code{g77} and @code{gcc}.
+It is possible that some of this information will be applicable
+to some @emph{binary} distributions of these products---however,
+since these distributions are not made by the maintainers of
+@code{g77}, responsibility for binary distributions rests with
+whoever built and first distributed them.
+
+Nevertheless, efforts to make @code{g77} easier to both build
+and install from source and package up as a binary distribution
+are ongoing.
+
+@menu
+* Prerequisites::          Make sure your system is ready for @code{g77}.
+* Problems Installing::    Known trouble areas.
+* Settings::               Changing @code{g77} internals before building.
+* Quick Start::            The easier procedure for non-experts.
+* Complete Installation::  For experts, or those who want to be: the details.
+* Distributing Binaries::  If you plan on distributing your @code{g77}.
+@end menu
+
+@node Prerequisites
+@section Prerequisites
+@cindex prerequisites
+
+The procedures described to unpack, configure, build, and
+install @code{g77} assume your system has certain programs
+already installed.
+
+The following prerequisites should be met by your
+system before you follow the @code{g77} installation instructions:
+
+@table @asis
+@item @code{gzip}
+To unpack the @code{gcc} and @code{g77} distributions,
+you'll need the @code{gunzip} utility in the @code{gzip}
+distribution.
+Most UNIX systems already have @code{gzip} installed.
+If yours doesn't, you can get it from the FSF.
+
+Note that you'll need @code{tar} and other utilities
+as well, but all UNIX systems have these.
+There are GNU versions of all these available---in fact,
+a complete GNU UNIX system can be put together on
+most systems, if desired.
+
+@item @file{gcc-2.7.2.2.tar.gz}
+You need to have this, or some other applicable, version
+of @code{gcc} on your system.
+The version should be an exact copy of a distribution
+from the FSF.
+It is approximately 7MB large.
+
+If you've already unpacked @file{gcc-2.7.2.2.tar.gz} into a
+directory (named @file{gcc-2.7.2.2}) called the @dfn{source tree}
+for @code{gcc}, you can delete the distribution
+itself, but you'll need to remember to skip any instructions to unpack
+this distribution.
+
+Without an applicable @code{gcc} source tree, you cannot
+build @code{g77}.
+You can obtain an FSF distribution of @code{gcc} from the FSF.
+
+@item @file{g77-0.5.21.tar.gz}
+You probably have already unpacked this distribution,
+or you are reading an advanced copy of this manual,
+which is contained in this distribution.
+This distribution approximately 1MB large.
+
+You can obtain an FSF distribution of @code{g77} from the FSF,
+the same way you obtained @code{gcc}.
+
+@item 100MB disk space
+For a complete @dfn{bootstrap} build, about 100MB
+of disk space is required for @code{g77} by the author's
+current GNU/Linux system.
+
+Some juggling can reduce the amount of space needed;
+during the bootstrap process, once Stage 3 starts,
+during which the version of @code{gcc} that has been copied
+into the @file{stage2/} directory is used to rebuild the
+system, you can delete the @file{stage1/} directory
+to free up some space.
+
+It is likely that many systems don't require the complete
+bootstrap build, as they already have a recent version of
+@code{gcc} installed.
+Such systems might be able to build @code{g77} with only
+about 75MB of free space.
+
+@item @code{patch}
+Although you can do everything @code{patch} does yourself,
+by hand, without much trouble, having @code{patch} installed
+makes installation of new versions of GNU utilities such as
+@code{g77} so much easier that it is worth getting.
+You can obtain @code{patch} the same way you obtained
+@code{gcc} and @code{g77}.
+
+In any case, you can apply patches by hand---patch files
+are designed for humans to read them.
+
+@item @code{make}
+Your system must have @code{make}, and you will probably save
+yourself a lot of trouble if it is GNU @code{make} (sometimes
+referred to as @code{gmake}).
+
+@item @code{cc}
+Your system must have a working C compiler.
+
+@xref{Installation,,Installing GNU CC,gcc,Using and Porting GNU CC},
+for more information on prerequisites for installing @code{gcc}.
+
+@item @code{bison}
+If you do not have @code{bison} installed, you can usually
+work around any need for it, since @code{g77} itself does
+not use it, and @code{gcc} normally includes all files
+generated by running it in its distribution.
+You can obtain @code{bison} the same way you obtained
+@code{gcc} and @code{g77}.
+
+@xref{Missing bison?},
+for information on how to work around not having @code{bison}.
+
+@item @code{makeinfo}
+If you are missing @code{makeinfo}, you can usually work
+around any need for it.
+You can obtain @code{makeinfo} the same way you obtained
+@code{gcc} and @code{g77}.
+
+@xref{Missing makeinfo?},
+for information on getting around the lack of @code{makeinfo}.
+
+@item @code{root} access
+To perform the complete installation procedures on a system,
+you need to have @code{root} access to that system, or
+equivalent access.
+
+Portions of the procedure (such as configuring and building
+@code{g77}) can be performed by any user with enough disk
+space and virtual memory.
+
+However, these instructions are oriented towards less-experienced
+users who want to install @code{g77} on their own personal
+systems.
+
+System administrators with more experience will want to
+determine for themselves how they want to modify the
+procedures described below to suit the needs of their
+installation.
+@end table
+
+@node Problems Installing
+@section Problems Installing
+@cindex problems installing
+@cindex installation problems
+
+This is a list of problems (and some apparent problems which don't
+really mean anything is wrong) that show up when configuring,
+building, installing, or porting GNU Fortran.
+
+@xref{Installation Problems,,,gcc,Using and Porting GNU CC},
+for more information on installation problems that can afflict
+either @code{gcc} or @code{g77}.
+
+@menu
+* General Problems::         Problems afflicting most or all systems.
+* Cross-compiler Problems::  Problems afflicting cross-compilation setups.
+@end menu
+
+@node General Problems
+@subsection General Problems
+
+These problems can occur on most or all systems.
+
+@menu
+* GNU C Required::	       Why even ANSI C is not enough.
+* Patching GNU CC Necessary::  Why @code{gcc} must be patched first.
+* Building GNU CC Necessary::  Why you can't build @emph{just} Fortran.
+* Missing strtoul::	       If linking @code{f771} fails due to an
+                                unresolved reference to @code{strtoul}.
+* Object File Differences::    It's okay that @samp{make compare} will
+                                flag @file{f/zzz.o}.
+* Cleanup Kills Stage Directories::  A minor nit for @code{g77} developers.
+* Missing gperf?::             When building requires @code{gperf}.
+@end menu
+
+@node GNU C Required
+@subsubsection GNU C Required
+@cindex GNU C required
+@cindex requirements, GNU C
+
+Compiling @code{g77} requires GNU C, not just ANSI C.
+Fixing this wouldn't
+be very hard (just tedious), but the code using GNU extensions to
+the C language is expected to be rewritten for 0.6 anyway,
+so there are no plans for an interim fix.
+
+This requirement does not mean you must already have @code{gcc}
+installed to build @code{g77}.
+As long as you have a working C compiler, you can use a
+bootstrap build to automate the process of first building
+@code{gcc} using the working C compiler you have, then building
+@code{g77} and rebuilding @code{gcc} using that just-built @code{gcc},
+and so on.
+
+@node Patching GNU CC Necessary
+@subsubsection Patching GNU CC Necessary
+@cindex patch files
+@cindex GBE
+
+@code{g77} currently requires application of a patch file to the gcc compiler
+tree.
+The necessary patches should be folded in to the mainline gcc distribution.
+
+Some combinations
+of versions of @code{g77} and @code{gcc} might actually @emph{require} no
+patches, but the patch files will be provided anyway as long as
+there are more changes expected in subsequent releases.
+These patch files might contain
+unnecessary, but possibly helpful, patches.
+As a result, it is possible this issue might never be
+resolved, except by eliminating the need for the person
+configuring @code{g77} to apply a patch by hand, by going
+to a more automated approach (such as configure-time patching).
+
+@node Building GNU CC Necessary
+@subsubsection Building GNU CC Necessary
+@cindex gcc, building
+@cindex building gcc
+
+It should be possible to build the runtime without building @code{cc1}
+and other non-Fortran items, but, for now, an easy way to do that
+is not yet established.
+
+@node Missing strtoul
+@subsubsection Missing strtoul
+@cindex strtoul
+@cindex _strtoul
+@cindex undefined reference (_strtoul)
+@cindex f771, linking error for
+@cindex linking error for f771
+@cindex ld error for f771
+@cindex ld can't find _strtoul
+@cindex SunOS4
+
+On SunOS4 systems, linking the @code{f771} program produces
+an error message concerning an undefined symbol named
+@samp{_strtoul}.
+
+This is not a @code{g77} bug.
+@xref{Patching GNU Fortran}, for information on
+a workaround provided by @code{g77}.
+
+The proper fix is either to upgrade your system to one that
+provides a complete ANSI C environment, or improve @code{gcc} so
+that it provides one for all the languages and configurations it supports.
+
+@emph{Note:} In earlier versions of @code{g77}, an automated
+workaround for this problem was attempted.
+It worked for systems without @samp{_strtoul}, substituting
+the incomplete-yet-sufficient version supplied with @code{g77}
+for those systems.
+However, the automated workaround failed mysteriously for systems
+that appeared to have conforming ANSI C environments, and it
+was decided that, lacking resources to more fully investigate
+the problem, it was better to not punish users of those systems
+either by requiring them to work around the problem by hand or
+by always substituting an incomplete @code{strtoul()} implementation
+when their systems had a complete, working one.
+Unfortunately, this meant inconveniencing users of systems not
+having @code{strtoul()}, but they're using obsolete (and generally
+unsupported) systems anyway.
+
+@node Object File Differences
+@subsubsection Object File Differences
+@cindex zzz.o
+@cindex zzz.c
+@cindex object file, differences
+@cindex differences between object files
+@cindex make compare
+
+A comparison of object files after building Stage 3 during a
+bootstrap build will result in @file{gcc/f/zzz.o} being flagged
+as different from the Stage 2 version.
+That is because it
+contains a string with an expansion of the @code{__TIME__} macro,
+which expands to the current time of day.
+It is nothing to worry about, since
+@file{gcc/f/zzz.c} doesn't contain any actual code.
+It does allow you to override its use of @code{__DATE__} and
+@code{__TIME__} by defining macros for the compilation---see the
+source code for details.
+
+@node Cleanup Kills Stage Directories
+@subsubsection Cleanup Kills Stage Directories
+@cindex stage directories
+@cindex make clean
+
+It'd be helpful if @code{g77}'s @file{Makefile.in} or @file{Make-lang.in}
+would create the various @file{stage@var{n}} directories and their
+subdirectories, so developers and expert installers wouldn't have to
+reconfigure after cleaning up.
+
+@node Missing gperf?
+@subsubsection Missing @code{gperf}?
+@cindex @code{gperf}
+@cindex missing @code{gperf}
+
+If a build aborts trying to invoke @code{gperf}, that
+strongly suggests an improper method was used to
+create the @code{gcc} source directory,
+such as the UNIX @samp{cp -r} command instead
+of @samp{cp -pr}, since this problem very likely
+indicates that the date-time-modified information on
+the @code{gcc} source files is incorrect.
+
+The proper solution is to recreate the @code{gcc} source
+directory from a @code{gcc} distribution known to be
+provided by the FSF.
+
+It is possible you might be able to temporarily
+work around the problem, however, by trying these
+commands:
+
+@example
+sh# @kbd{cd gcc}
+sh# @kbd{touch c-gperf.h}
+sh#
+@end example
+
+These commands update the date-time-modified information for
+the file produced by the invocation of @code{gperf}
+in the current versions of @code{gcc}, so that @code{make} no
+longer believes it needs to update it.
+This file should already exist in a @code{gcc}
+distribution, but mistakes made when copying the @code{gcc}
+directory can leave the modification information
+set such that the @code{gperf} input files look more ``recent''
+than the corresponding output files.
+
+If the above does not work, definitely start from scratch
+and avoid copying the @code{gcc} using any method that does
+not reliably preserve date-time-modified information, such
+as the UNIX @samp{cp -r} command.
+
+@node Cross-compiler Problems
+@subsection Cross-compiler Problems
+@cindex cross-compiler, problems
+
+@code{g77} has been in alpha testing since September of
+1992, and in public beta testing since February of 1995.
+Alpha testing was done by a small number of people worldwide on a fairly
+wide variety of machines, involving self-compilation in most or
+all cases.
+Beta testing has been done primarily via self-compilation,
+but in more and more cases, cross-compilation (and ``criss-cross
+compilation'', where a version of a compiler is built on one machine
+to run on a second and generate code that runs on a third) has
+been tried and has succeeded, to varying extents.
+
+Generally, @code{g77} can be ported to any configuration to which
+@code{gcc}, @code{f2c}, and @code{libf2c} can be ported and made
+to work together, aside from the known problems described in this
+manual.
+If you want to port @code{g77} to a particular configuration,
+you should first make sure @code{gcc} and @code{libf2c} can be
+ported to that configuration before focusing on @code{g77}, because
+@code{g77} is so dependent on them.
+
+Even for cases where @code{gcc} and @code{libf2c} work,
+you might run into problems with cross-compilation on certain machines,
+for several reasons.
+
+@itemize @bullet
+@item
+There is one known bug
+(a design bug to be fixed in 0.6) that prevents configuration of
+@code{g77} as a cross-compiler in some cases,
+though there are assumptions made during
+configuration that probably make doing non-self-hosting builds
+a hassle, requiring manual intervention.
+
+@item
+@code{gcc} might still have some trouble being configured
+for certain combinations of machines.
+For example, it might not know how to handle floating-point
+constants.
+
+@item
+Improvements to the way @code{libf2c} is built could make
+building @code{g77} as a cross-compiler easier---for example,
+passing and using @samp{LD} and @samp{AR} in the appropriate
+ways.
+
+@item
+There are still some challenges putting together the right
+run-time libraries (needed by @code{libf2c}) for a target
+system, depending on the systems involved in the configuration.
+(This is a general problem with cross-compilation, and with
+@code{gcc} in particular.)
+@end itemize
+
+@node Settings
+@section Changing Settings Before Building
+
+Here are some internal @code{g77} settings that can be changed
+by editing source files in @file{gcc/f/} before building.
+
+This information, and perhaps even these settings, represent
+stop-gap solutions to problems people doing various ports
+of @code{g77} have encountered.
+As such, none of the following information is expected to
+be pertinent in future versions of @code{g77}.
+
+@menu
+* Larger File Unit Numbers::     Raising @samp{MXUNIT}.
+* Always Flush Output::          Synchronizing write errors.
+* Maximum Stackable Size::       Large arrays are forced off the stack frame.
+* Floating-point Bit Patterns::  Possible programs building cross-compiler.
+* Large Initialization::         Large arrays with @code{DATA} initialization.
+* Alpha Problems Fixed::         Problems 64-bit systems like Alphas now fixed?
+@end menu
+
+@node Larger File Unit Numbers
+@subsection Larger File Unit Numbers
+@cindex MXUNIT
+@cindex unit numbers
+@cindex maximum unit number
+@cindex illegal unit number
+@cindex increasing maximum unit number
+
+As distributed, whether as part of @code{f2c} or @code{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 @samp{MXUNIT} macro, which represents the maximum unit
+number, to an appropriately higher value.
+
+To do this, edit the file @file{f/runtime/libI77/fio.h} in your
+@code{g77} source tree, changing the following line:
+
+@example
+#define MXUNIT 100
+@end example
+
+Change the line so that the value of @samp{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
+@samp{MXUNIT} set to at least 256 to avoid crashing.)
+
+Then build or rebuild @code{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 Always Flush Output
+@subsection Always Flush Output
+@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
+
+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{libf2c} supports flagging write errors immediately when
+it is built with the @samp{ALWAYS_FLUSH} macro defined.
+This results in a @code{libf2c} 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 @code{g77} you are building, you might wish to
+modify the @code{g77} source tree so that the version of
+@code{libf2c} is built with the @samp{ALWAYS_FLUSH} macro
+defined, enabling this behavior.
+
+To do this, find this line in @file{f/runtime/configure.in} in
+your @code{g77} source tree:
+
+@example
+dnl AC_DEFINE(ALWAYS_FLUSH)
+@end example
+
+Remove the leading @samp{dnl@w{ }}, so the line begins with
+@samp{AC_DEFINE(}, and run @code{autoconf} in that file's directory.
+(Or, if you don't have @code{autoconf}, you can modify @file{f2c.h.in}
+in the same directory to include the line @samp{#define ALWAYS_FLUSH}
+after @samp{#define F2C_INCLUDE}.)
+
+Then build or rebuild @code{g77} as appropriate.
+
+@node Maximum Stackable Size
+@subsection Maximum Stackable Size
+@vindex FFECOM_sizeMAXSTACKITEM
+@cindex code, stack variables
+@cindex maximum stackable size
+@cindex stack allocation
+@cindex segmentation violation
+@code{g77}, on most machines, puts many variables and arrays on the stack
+where possible, and can be configured (by changing
+@samp{FFECOM_sizeMAXSTACKITEM} in @file{gcc/f/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 @samp{FFECOM_sizeMAXSTACKITEM} has no
+effect on automatic variables and arrays.
+@xref{But-bugs}, for more information.
+
+@node Floating-point Bit Patterns
+@subsection Floating-point Bit Patterns
+
+@cindex cross-compiler, building
+@cindex floating-point bit patterns
+@cindex bit patterns
+The @code{g77} build will crash if an attempt is made to build
+it as a cross-compiler
+for a target when @code{g77} cannot reliably determine the bit pattern of
+floating-point constants for the target.
+Planned improvements for g77-0.6
+will give it the capabilities it needs to not have to crash the build
+but rather generate correct code for the target.
+(Currently, @code{g77}
+would generate bad code under such circumstances if it didn't crash
+during the build, e.g. when compiling a source file that does
+something like @samp{EQUIVALENCE (I,R)} and @samp{DATA R/9.43578/}.)
+
+@node Large Initialization
+@subsection Initialization of Large Aggregate Areas
+
+@cindex speed, compiler
+@cindex slow compiler
+@cindex memory utilization
+@cindex large initialization
+@cindex aggregate initialization
+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{gcc/f/data.c}, the macro
+@samp{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.
+
+@node Alpha Problems Fixed
+@subsection Alpha Problems Fixed
+
+@cindex Alpha, support
+@cindex 64-bit systems
+@code{g77} used to warn when it was used to compile Fortran code
+for a target configuration that is not basically a 32-bit
+machine (such as an Alpha, which is a 64-bit machine, especially
+if it has a 64-bit operating system running on it).
+That was because @code{g77} was known to not work
+properly on such configurations.
+
+As of version 0.5.20, @code{g77} is believed to work well
+enough on such systems.
+So, the warning is no longer needed or provided.
+
+However, support for 64-bit systems, especially in
+areas such as cross-compilation and handling of
+intrinsics, is still incomplete.
+The symptoms
+are believed to be compile-time diagnostics rather
+than the generation of bad code.
+It is hoped that version 0.6 will completely support 64-bit
+systems.
+
+@node Quick Start
+@section Quick Start
+@cindex quick start
+
+This procedure configures, builds, and installs @code{g77}
+``out of the box'' and works on most UNIX systems.
+Each command is identified by a unique number,
+used in the explanatory text that follows.
+For the most part, the output of each command is not shown,
+though indications of the types of responses are given in a
+few cases.
+
+To perform this procedure, the installer must be logged
+in as user @code{root}.
+Much of it can be done while not logged in as @code{root},
+and users experienced with UNIX administration should be
+able to modify the procedure properly to do so.
+
+Following traditional UNIX conventions, it is assumed that
+the source trees for @code{g77} and @code{gcc} will be
+placed in @file{/usr/src}.
+It also is assumed that the source distributions themselves
+already reside in @file{/usr/FSF}, a naming convention
+used by the author of @code{g77} on his own system:
+
+@example
+/usr/FSF/gcc-2.7.2.2.tar.gz
+/usr/FSF/g77-0.5.21.tar.gz
+@end example
+
+@c (You can use @file{gcc-2.7.2.1.tar.gz} instead, or
+@c the equivalent of it obtained by applying the
+@c patch distributed as @file{gcc-2.7.2-2.7.2.1.diff.gz}
+@c to version 2.7.2 of @code{gcc},
+@c if you remember to make the appropriate adjustments in the
+@c instructions below.)
+
+@cindex SunOS4
+Users of the following systems should not blindly follow
+these quick-start instructions, because of problems their
+systems have coping with straightforward installation of
+@code{g77}:
+
+@itemize @bullet
+@item
+SunOS4
+@end itemize
+
+Instead, see @ref{Complete Installation}, for detailed information
+on how to configure, build, and install @code{g77} for your
+particular system.
+Also, see @ref{Trouble,,Known Causes of Trouble with GNU Fortran},
+for information on bugs and other problems known to afflict the
+installation process, and how to report newly discovered ones.
+
+If your system is @emph{not} on the above list, and @emph{is}
+a UNIX system or one of its variants, you should be able to
+follow the instructions below.
+If you vary @emph{any} of the steps below, you might run into
+trouble, including possibly breaking existing programs for
+other users of your system.
+Before doing so, it is wise to review the explanations of some
+of the steps.
+These explanations follow this list of steps.
+
+@example
+sh[ 1]# @kbd{cd /usr/src}
+@set source-dir 1
+sh[ 2]# @kbd{gunzip -c < /usr/FSF/gcc-2.7.2.2.tar.gz | tar xf -}
+[Might say "Broken pipe"...that is normal on some systems.]
+@set unpack-gcc 2
+sh[ 3]# @kbd{gunzip -c < /usr/FSF/g77-0.5.21.tar.gz | tar xf -}
+["Broken pipe" again possible.]
+@set unpack-g77 3
+sh[ 4]# @kbd{ln -s gcc-2.7.2.2 gcc}
+@set link-gcc 4
+sh[ 5]# @kbd{ln -s g77-0.5.21 g77}
+@set link-g77 5
+sh[ 6]# @kbd{mv -i g77/* gcc}
+[No questions should be asked by mv here; or, you made a mistake.]
+@set merge-g77 6
+sh[ 7]# @kbd{patch -p1 -V t -d gcc < gcc/f/gbe/2.7.2.2.diff}
+[Unless patch complains about rejected patches, this step worked.]
+@set apply-patch 7
+sh[ 8]# @kbd{cd gcc}
+sh[ 9]# @kbd{touch f77-install-ok}
+[Do not do the above if your system already has an f77
+command, unless you've checked that overwriting it
+is okay.]
+@set f77-install-ok 9
+sh[10]# @kbd{touch f2c-install-ok}
+[Do not do the above if your system already has an f2c
+command, unless you've checked that overwriting it
+is okay.  Else, @kbd{touch f2c-exists-ok}.]
+@set f2c-install-ok 10
+sh[11]# @kbd{./configure --prefix=/usr}
+[Do not do the above if gcc is not installed in /usr/bin.
+You might need a different @kbd{--prefix=@dots{}}, as
+described below.]
+@set configure-gcc 11
+sh[12]# @kbd{make bootstrap}
+[This takes a long time, and is where most problems occur.]
+@set build-gcc 12
+sh[13]# @kbd{make compare}
+[This verifies that the compiler is `sane'.  Only
+the file `f/zzz.o' (aka `tmp-foo1' and `tmp-foo2')
+should be in the list of object files this command
+prints as having different contents.  If other files
+are printed, you have likely found a g77 bug.]
+@set compare-gcc 13
+sh[14]# @kbd{rm -fr stage1}
+@set rm-stage1 14
+sh[15]# @kbd{make -k install}
+[The actual installation.]
+@set install-g77 15
+sh[16]# @kbd{g77 -v}
+[Verify that g77 is installed, obtain version info.]
+@set show-version 16
+sh[17]#
+@set end-procedure 17
+@end example
+
+@xref{Updating Documentation,,Updating Your Info Directory}, for
+information on how to update your system's top-level @code{info}
+directory to contain a reference to this manual, so that
+users of @code{g77} can easily find documentation instead
+of having to ask you for it.
+
+Elaborations of many of the above steps follows:
+
+@table @asis
+@item Step @value{source-dir}: @kbd{cd /usr/src}
+You can build @code{g77} pretty much anyplace.
+By convention, this manual assumes @file{/usr/src}.
+It might be helpful if other users on your system
+knew where to look for the source code for the
+installed version of @code{g77} and @code{gcc} in any case.
+
+@c @item Step @value{unpack-gcc}: @kbd{gunzip -d @dots{}}
+@c Here, you might wish to use @file{gcc-2.7.2.1.tar.gz}
+@c instead, or apply @file{gcc-2.7.2-2.7.2.1.diff.gz} to achieve
+@c similar results.
+
+@item Step @value{unpack-g77}: @kbd{gunzip -d < /usr/FSF/g77-0.5.21.tar.gz | tar xf -}
+It is not always necessary to obtain the latest version of
+@code{g77} as a complete @file{.tar.gz} file if you have
+a complete, earlier distribution of @code{g77}.
+If appropriate, you can unpack that earlier
+version of @code{g77}, and then apply the appropriate patches
+to achieve the same result---a source tree containing version
+0.5.21 of @code{g77}.
+
+@item Step @value{link-gcc}: @kbd{ln -s gcc-2.7.2.2 gcc}
+@item Step @value{link-g77}: @kbd{ln -s g77-0.5.21 g77}
+These commands mainly help reduce typing,
+and help reduce visual clutter in examples
+in this manual showing what to type to install @code{g77}.
+
+@c Of course, if appropriate, @kbd{ln -s gcc-2.7.2.1 gcc} or
+@c similar.
+
+@xref{Unpacking}, for information on
+using distributions of @code{g77} made by organizations
+other than the FSF.
+
+@item Step @value{merge-g77}: @kbd{mv -i g77/* gcc}
+After doing this, you can, if you like, type
+@samp{rm g77} and @samp{rmdir g77-0.5.21} to remove
+the empty directory and the symbol link to it.
+But, it might be helpful to leave them around as
+quick reminders of which version(s) of @code{g77} are
+installed on your system.
+
+@xref{Unpacking}, for information
+on the contents of the @file{g77} directory (as merged
+into the @file{gcc} directory).
+
+@item Step @value{apply-patch}: @kbd{patch -p1 @dots{}}
+@c (Or `@kbd{@dots{} < gcc/f/gbe/2.7.2.1.diff}', if appropriate.)
+@c
+This can produce a wide variety of printed output,
+from @samp{Hmm, I can't seem to find a patch in there anywhere...}
+to long lists of messages indicated that patches are
+being found, applied successfully, and so on.
+
+If messages about ``fuzz'', ``offset'', or
+especially ``reject files'' are printed, it might
+mean you applied the wrong patch file.
+If you believe this is the case, it is best to restart
+the sequence after deleting (or at least renaming to unused
+names) the top-level directories for @code{g77} and @code{gcc}
+and their symbolic links.
+
+After this command finishes, the @code{gcc} directory might
+have old versions of several files as saved by @code{patch}.
+To remove these, after @kbd{cd gcc}, type @kbd{rm -i *.~*~}.
+
+@xref{Merging Distributions}, for more information.
+
+@item Step @value{f77-install-ok}: @kbd{touch f77-install-ok}
+Don't do this if you don't want to overwrite an existing
+version of @code{f77} (such as a native compiler, or a
+script that invokes @code{f2c}).
+Otherwise, installation will overwrite the @code{f77} command
+and the @code{f77} man pages with copies of the corresponding
+@code{g77} material.
+
+@xref{Installing f77,,Installing @code{f77}}, for more
+information.
+
+@item Step @value{f2c-install-ok}: @kbd{touch f2c-install-ok}
+Don't do this if you don't want to overwrite an existing
+installation of @code{libf2c} (though, chances are, you do).
+Instead, @kbd{touch f2c-exists-ok} to allow the installation
+to continue without any error messages about @file{/usr/lib/libf2c.a}
+already existing.
+
+@xref{Installing f2c,,Installing @code{f2c}}, for more
+information.
+
+@item Step @value{configure-gcc}: @kbd{./configure --prefix=/usr}
+This is where you specify that the @file{g77} executable is to be
+installed in @file{/usr/bin/}, the @file{libf2c.a} library is
+to be installed in @file{/usr/lib/}, and so on.
+
+You should ensure that any existing installation of the @file{gcc}
+executable is in @file{/usr/bin/}.
+Otherwise, installing @code{g77} so that it does not fully
+replace the existing installation of @code{gcc} is likely
+to result in the inability to compile Fortran programs.
+
+@xref{Where to Install,,Where in the World Does Fortran (and GNU CC) Go?},
+for more information on determining where to install @code{g77}.
+@xref{Configuring gcc}, for more information on the
+configuration process triggered by invoking the @file{./configure}
+script.
+
+@item Step @value{build-gcc}: @kbd{make bootstrap}
+@xref{Installation,,Installing GNU CC,
+gcc,Using and Porting GNU CC}, for information
+on the kinds of diagnostics you should expect during
+this procedure.
+
+@xref{Building gcc}, for complete @code{g77}-specific
+information on this step.
+
+@item Step @value{compare-gcc}: @kbd{make compare}
+@xref{Bug Lists,,Where to Port Bugs}, for information
+on where to report that you observed more than
+@file{f/zzz.o} having different contents during this
+phase.
+
+@xref{Bug Reporting,,How to Report Bugs}, for
+information on @emph{how} to report bugs like this.
+
+@item Step @value{rm-stage1}: @kbd{rm -fr stage1}
+You don't need to do this, but it frees up disk space.
+
+@item Step @value{install-g77}: @kbd{make -k install}
+If this doesn't seem to work, try:
+
+@example
+make -k install install-libf77 install-f2c-all
+@end example
+
+@xref{Installation of Binaries}, for more information.
+
+@xref{Updating Documentation,,Updating Your Info Directory},
+for information on entering this manual into your
+system's list of texinfo manuals.
+
+@item Step @value{show-version}: @kbd{g77 -v}
+If this command prints approximately 25 lines of output,
+including the GNU Fortran Front End version number (which
+should be the same as the version number for the version
+of @code{g77} you just built and installed) and the
+version numbers for the three parts of the @code{libf2c}
+library (@code{libF77}, @code{libI77}, @code{libU77}), and
+those version numbers are all in agreement, then there is
+a high likelihood that the installation has been successfully
+completed.
+
+You might consider doing further testing.
+For example, log in as a non-privileged user, then create
+a small Fortran program, such as:
+
+@example
+      PROGRAM SMTEST
+      DO 10 I=1, 10
+         PRINT *, 'Hello World #', I
+10    CONTINUE
+      END
+@end example
+
+Compile, link, and run the above program, and, assuming you named
+the source file @file{smtest.f}, the session should look like this:
+
+@example
+sh# @kbd{g77 -o smtest smtest.f}
+sh# @kbd{./smtest}
+ Hello World # 1
+ Hello World # 2
+ Hello World # 3
+ Hello World # 4
+ Hello World # 5
+ Hello World # 6
+ Hello World # 7
+ Hello World # 8
+ Hello World # 9
+ Hello World # 10
+sh#
+@end example
+
+After proper installation, you don't
+need to keep your gcc and g77 source and build directories
+around anymore.
+Removing them can free up a lot of disk space.
+@end table
+
+@node Complete Installation
+@section Complete Installation
+
+Here is the complete @code{g77}-specific information on how
+to configure, build, and install @code{g77}.
+
+@menu
+* Unpacking::
+* Merging Distributions::
+* f77: Installing f77.
+* f2c: Installing f2c.
+* Patching GNU Fortran::
+* Where to Install::
+* Configuring gcc::
+* Building gcc::
+* Pre-installation Checks::
+* Installation of Binaries::
+* Updating Documentation::
+* bison: Missing bison?.
+* makeinfo: Missing makeinfo?.
+@end menu
+
+@node Unpacking
+@subsection Unpacking
+@cindex unpacking distributions
+@cindex distributions, unpacking
+@cindex code, source
+@cindex source code
+@cindex source tree
+@cindex packages
+
+The @code{gcc} source distribution is a stand-alone distribution.
+It is designed to be unpacked (producing the @code{gcc}
+source tree) and built as is, assuming certain
+prerequisites are met (including the availability of compatible
+UNIX programs such as @code{make}, @code{cc}, and so on).
+
+However, before building @code{gcc}, you will want to unpack
+and merge the @code{g77} distribution in with it, so that you
+build a Fortran-capable version of @code{gcc}, which includes
+the @code{g77} command, the necessary run-time libraries,
+and this manual.
+
+Unlike @code{gcc}, the @code{g77} source distribution
+is @emph{not} a stand-alone distribution.
+It is designed to be unpacked and, afterwards, immediately merged
+into an applicable @code{gcc} source tree.
+That is, the @code{g77} distribution @emph{augments} a
+@code{gcc} distribution---without @code{gcc}, generally
+only the documentation is immediately usable.
+
+A sequence of commands typically used to unpack @code{gcc}
+and @code{g77} is:
+
+@example
+sh# @kbd{cd /usr/src}
+sh# @kbd{gunzip -d < /usr/FSF/gcc-2.7.2.2.tar.gz | tar xf -}
+sh# @kbd{gunzip -d < /usr/FSF/g77-0.5.21.tar.gz | tar xf -}
+sh# @kbd{ln -s gcc-2.7.2.2 gcc}
+sh# @kbd{ln -s g77-0.5.21 g77}
+sh# @kbd{mv -i g77/* gcc}
+@end example
+
+@emph{Notes:} The commands beginning with @samp{gunzip@dots{}} might
+print @samp{Broken pipe@dots{}} as they complete.
+That is nothing to worry about, unless you actually
+@emph{hear} a pipe breaking.
+The @code{ln} commands are helpful in reducing typing
+and clutter in installation examples in this manual.
+Hereafter, the top level of @code{gcc} source tree is referred to
+as @file{gcc}, and the top level of just the @code{g77}
+source tree (prior to issuing the @code{mv} command, above)
+is referred to as @file{g77}.
+
+There are three top-level names in a @code{g77} distribution:
+
+@example
+g77/COPYING.g77
+g77/README.g77
+g77/f
+@end example
+
+All three entries should be moved (or copied) into a @code{gcc}
+source tree (typically named after its version number and
+as it appears in the FSF distributions---e.g. @file{gcc-2.7.2.2}).
+
+@file{g77/f} is the subdirectory containing all of the
+code, documentation, and other information that is specific
+to @code{g77}.
+The other two files exist to provide information on @code{g77}
+to someone encountering a @code{gcc} source tree with @code{g77}
+already present, who has not yet read these installation
+instructions and thus needs help understanding that the
+source tree they are looking at does not come from a single
+FSF distribution.
+They also help people encountering an unmerged @code{g77} source
+tree for the first time.
+
+@cindex modifying @code{g77}
+@cindex code, modifying
+@cindex Pentium optimizations
+@cindex optimizations, Pentium
+@emph{Note:} Please use @strong{only} @code{gcc} and @code{g77}
+source trees as distributed by the FSF.
+Use of modified versions, such as the Pentium-specific-optimization
+port of @code{gcc}, is likely to result in problems that appear to be
+in the @code{g77} code but, in fact, are not.
+Do not use such modified versions
+unless you understand all the differences between them and the versions
+the FSF distributes---in which case you should be able to modify the
+@code{g77} (or @code{gcc}) source trees appropriately so @code{g77}
+and @code{gcc} can coexist as they do in the stock FSF distributions.
+
+@node Merging Distributions
+@subsection Merging Distributions
+@cindex merging distributions
+@cindex @code{gcc} versions supported by @code{g77}
+@cindex versions of @code{gcc}
+@cindex support for @code{gcc} versions
+
+After merging the @code{g77} source tree into the @code{gcc}
+source tree, the final merge step is done by applying the
+pertinent patches the @code{g77} distribution provides for
+the @code{gcc} source tree.
+
+Read the file @file{gcc/f/gbe/README}, and apply the appropriate
+patch file for the version of the GNU CC compiler you have, if
+that exists.
+If the directory exists but the appropriate file
+does not exist, you are using either an old, unsupported version,
+or a release one that is newer than the newest @code{gcc} version
+supported by the version of @code{g77} you have.
+
+@cindex gcc version numbering
+@cindex version numbering
+@cindex g77 version number
+@cindex GNU version numbering
+As of version 0.5.18, @code{g77} modifies the version number
+of @code{gcc} via the pertinent patches.
+This is done because the resulting version of @code{gcc} is
+deemed sufficiently different from the vanilla distribution
+to make it worthwhile to present, to the user, information
+signaling the fact that there are some differences.
+
+GNU version numbers make it easy to figure out whether a
+particular version of a distribution is newer or older than
+some other version of that distribution.
+The format is,
+generally, @var{major}.@var{minor}.@var{patch}, with
+each field being a decimal number.
+(You can safely ignore
+leading zeros; for example, 1.5.3 is the same as 1.5.03.)@ 
+The @var{major} field only increases with time.
+The other two fields are reset to 0 when the field to
+their left is incremented; otherwise, they, too, only
+increase with time.
+So, version 2.6.2 is newer than version 2.5.8, and
+version 3.0 is newer than both.
+(Trailing @samp{.0} fields often are omitted in
+announcements and in names for distributions and
+the directories they create.)
+
+If your version of @code{gcc} is older than the oldest version
+supported by @code{g77} (as casually determined by listing
+the contents of @file{gcc/f/gbe/}), you should obtain a newer,
+supported version of @code{gcc}.
+(You could instead obtain an older version of @code{g77},
+or try and get your @code{g77} to work with the old
+@code{gcc}, but neither approach is recommended, and
+you shouldn't bother reporting any bugs you find if you
+take either approach, because they're probably already
+fixed in the newer versions you're not using.)
+
+If your version of @code{gcc} is newer than the newest version
+supported by @code{g77}, it is possible that your @code{g77}
+will work with it anyway.
+If the version number for @code{gcc} differs only in the
+@var{patch} field, you might as well try applying the @code{g77} patch
+that is for the newest version of @code{gcc} having the same
+@var{major} and @var{minor} fields, as this is likely to work.
+
+So, for example, if a particular version of @code{g77} has support for
+@code{gcc} versions 2.7.0 and 2.7.1,
+it is likely that @file{gcc-2.7.2} would work well with @code{g77}
+by using the @file{2.7.1.diff} patch file provided
+with @code{g77} (aside from some offsets reported by @code{patch},
+which usually are harmless).
+
+However, @file{gcc-2.8.0} would almost certainly
+not work with that version of @code{g77} no matter which patch file was
+used, so a new version of @code{g77} would be needed (and you should
+wait for it rather than bothering the maintainers---@pxref{Changes,,
+User-Visible Changes}).
+
+@cindex distributions, why separate
+@cindex separate distributions
+@cindex why separate distributions
+This complexity is the result of @code{gcc} and @code{g77} being
+separate distributions.
+By keeping them separate, each product is able to be independently
+improved and distributed to its user base more frequently.
+
+However, @code{g77} often requires changes to contemporary
+versions of @code{gcc}.
+Also, the GBE interface defined by @code{gcc} typically
+undergoes some incompatible changes at least every time the
+@var{minor} field of the version number is incremented,
+and such changes require corresponding changes to
+the @code{g77} front end (FFE).
+
+It is hoped that the GBE interface, and the @code{gcc} and
+@code{g77} products in general, will stabilize sufficiently
+for the need for hand-patching to disappear.
+
+Invoking @code{patch} as described in @file{gcc/f/gbe/README}
+can produce a wide variety of printed output,
+from @samp{Hmm, I can't seem to find a patch in there anywhere...}
+to long lists of messages indicated that patches are
+being found, applied successfully, and so on.
+
+If messages about ``fuzz'', ``offset'', or
+especially ``reject files'' are printed, it might
+mean you applied the wrong patch file.
+If you believe this is the case, it is best to restart
+the sequence after deleting (or at least renaming to unused
+names) the top-level directories for @code{g77} and @code{gcc}
+and their symbolic links.
+That is because @code{patch} might have partially patched
+some @code{gcc} source files, so reapplying the correct
+patch file might result in the correct patches being
+applied incorrectly (due to the way @code{patch} necessarily
+works).
+
+After @code{patch} finishes, the @code{gcc} directory might
+have old versions of several files as saved by @code{patch}.
+To remove these, after @kbd{cd gcc}, type @kbd{rm -i *.~*~}.
+
+@pindex config-lang.in
+@emph{Note:} @code{g77}'s configuration file @file{gcc/f/config-lang.in}
+ensures that the source code for the version of @code{gcc}
+being configured has at least one indication of being patched
+as required specifically by @code{g77}.
+This configuration-time
+checking should catch failure to apply the correct patch and,
+if so caught, should abort the configuration with an explanation.
+@emph{Please} do not try to disable the check,
+otherwise @code{g77} might well appear to build
+and install correctly, and even appear to compile correctly,
+but could easily produce broken code.
+
+@cindex creating patch files
+@cindex patch files, creating
+@pindex gcc/f/gbe/
+@samp{diff -rcp2N} is used to create the patch files
+in @file{gcc/f/gbe/}.
+
+@node Installing f77
+@subsection Installing @code{f77}
+@cindex f77 command
+@cindex commands, f77
+@cindex native compiler
+
+You should decide whether you want installation of @code{g77}
+to also install an @code{f77} command.
+On systems with a native @code{f77}, this is not
+normally desired, so @code{g77} does not do this by
+default.
+
+@pindex f77-install-ok
+@vindex F77_INSTALL_FLAG
+If you want @code{f77} installed, create the file @file{f77-install-ok}
+(e.g. via the UNIX command @samp{touch f77-install-ok}) in the
+source or build top-level directory (the same directory in
+which the @code{g77} @file{f} directory resides, not the @file{f} directory
+itself), or edit @file{gcc/f/Make-lang.in} and change the definition
+of the @samp{F77_INSTALL_FLAG} macro appropriately.
+
+Usually, this means that, after typing @samp{cd gcc}, you
+would type @samp{touch f77-install-ok}.
+
+When you enable installation of @code{f77}, either a link to or a
+direct copy of the @code{g77} command is made.
+Similarly, @file{f77.1} is installed as a man page.
+
+(The @code{uninstall} target in the @file{gcc/Makefile} also tests
+this macro and file, when invoked, to determine whether to delete the
+installed copies of @code{f77} and @file{f77.1}.)
+
+@emph{Note:} No attempt is yet made
+to install a program (like a shell script) that provides
+compatibility with any other @code{f77} programs.
+Only the most rudimentary invocations of @code{f77} will
+work the same way with @code{g77}.
+
+@node Installing f2c
+@subsection Installing @code{f2c}
+
+Currently, @code{g77} does not include @code{f2c} itself in its
+distribution.
+However, it does include a modified version of the @code{libf2c}.
+This version is normally compatible with @code{f2c}, but has been
+modified to meet the needs of @code{g77} in ways that might possibly
+be incompatible with some versions or configurations of @code{f2c}.
+
+Decide how installation of @code{g77} should affect any existing installation
+of @code{f2c} on your system.
+
+@pindex f2c
+@pindex f2c.h
+@pindex libf2c.a
+@pindex libF77.a
+@pindex libI77.a
+If you do not have @code{f2c} on your system (e.g. no @file{/usr/bin/f2c},
+no @file{/usr/include/f2c.h}, and no @file{/usr/lib/libf2c.a},
+@file{/usr/lib/libF77.a}, or @file{/usr/lib/libI77.a}), you don't need to
+be concerned with this item.
+
+If you do have @code{f2c} on your system, you need to decide how users
+of @code{f2c} will be affected by your installing @code{g77}.
+Since @code{g77} is
+currently designed to be object-code-compatible with @code{f2c} (with
+very few, clear exceptions), users of @code{f2c} might want to combine
+@code{f2c}-compiled object files with @code{g77}-compiled object files in a
+single executable.
+
+To do this, users of @code{f2c} should use the same copies of @file{f2c.h} and
+@file{libf2c.a} that @code{g77} uses (and that get built as part of
+@code{g77}).
+
+If you do nothing here, the @code{g77} installation process will not
+overwrite the @file{include/f2c.h} and @file{lib/libf2c.a} files with its
+own versions, and in fact will not even install @file{libf2c.a} for use
+with the newly installed versions of @code{gcc} and @code{g77} if it sees
+that @file{lib/libf2c.a} exists---instead, it will print an explanatory
+message and skip this part of the installation.
+
+@pindex f2c-install-ok
+@vindex F2C_INSTALL_FLAG
+To install @code{g77}'s versions of @file{f2c.h} and @file{libf2c.a}
+in the appropriate
+places, create the file @file{f2c-install-ok} (e.g. via the UNIX
+command @samp{touch f2c-install-ok}) in the source or build top-level
+directory (the same directory in which the @code{g77} @file{f} directory
+resides, not the @file{f} directory itself), or edit @file{gcc/f/Make-lang.in}
+and change the definition of the @samp{F2C_INSTALL_FLAG} macro appropriately.
+
+Usually, this means that, after typing @samp{cd gcc}, you
+would type @samp{touch f2c-install-ok}.
+
+Make sure that when you enable the overwriting of @file{f2c.h}
+and @file{libf2c.a}
+as used by @code{f2c}, you have a recent and properly configured version of
+@file{bin/f2c} so that it generates code that is compatible with @code{g77}.
+
+@pindex f2c-exists-ok
+@vindex F2CLIBOK
+If you don't want installation of @code{g77} to overwrite @code{f2c}'s existing
+installation, but you do want @code{g77} installation to proceed with
+installation of its own versions of @file{f2c.h} and @file{libf2c.a} in places
+where @code{g77} will pick them up (even when linking @code{f2c}-compiled
+object files---which might lead to incompatibilities), create
+the file @file{f2c-exists-ok} (e.g. via the UNIX command
+@samp{touch f2c-exists-ok}) in the source or build top-level directory,
+or edit @file{gcc/f/Make-lang.in} and change the definition of the
+@samp{F2CLIBOK} macro appropriately.
+
+@node Patching GNU Fortran
+@subsection Patching GNU Fortran
+
+If you're using a SunOS4 system, you'll need to make the following
+change to @file{gcc/f/proj.h}: edit the line reading
+
+@example
+#define FFEPROJ_STRTOUL 1  @dots{}
+@end example
+
+@noindent
+by replacing the @samp{1} with @samp{0}.
+Or, you can avoid editing the source by adding
+@example
+CFLAGS='-DFFEPROJ_STRTOUL=0 -g -O'
+@end example
+to the command line for @code{make} when you invoke it.
+(@samp{-g} is the default for @samp{CFLAGS}.)
+
+This causes a minimal version of @code{strtoul()} provided
+as part of the @code{g77} distribution to be compiled and
+linked into whatever @code{g77} programs need it, since
+some systems (like SunOS4 with only the bundled compiler and its
+runtime) do not provide this function in their system libraries.
+
+Similarly, a minimal version of @code{bsearch()} is available
+and can be enabled by editing a line similar to the one
+for @code{strtoul()} above in @file{gcc/f/proj.h}, if
+your system libraries lack @code{bsearch()}.
+The method of overriding @samp{X_CFLAGS} may also be used.
+
+These are not problems with @code{g77}, which requires an
+ANSI C environment.
+You should upgrade your system to one that provides
+a full ANSI C environment, or encourage the maintainers
+of @code{gcc} to provide one to all @code{gcc}-based
+compilers in future @code{gcc} distributions.
+
+@xref{Problems Installing}, for more information on
+why @code{strtoul()} comes up missing and on approaches
+to dealing with this problem that have already been tried.
+
+@node Where to Install
+@subsection Where in the World Does Fortran (and GNU CC) Go?
+@cindex language f77 not recognized
+@cindex gcc will not compile Fortran programs
+
+Before configuring, you should make sure you know
+where you want the @code{g77} and @code{gcc}
+binaries to be installed after they're built,
+because this information is given to the configuration
+tool and used during the build itself.
+
+A @code{g77} installation necessarily requires installation of
+a @code{g77}-aware version of @code{gcc}, so that the @code{gcc}
+command recognizes Fortran source files and knows how to compile
+them.
+
+For this to work, the version of @code{gcc} that you will be building
+as part of @code{g77} @strong{must} be installed as the ``active''
+version of @code{gcc} on the system.
+
+Sometimes people make the mistake of installing @code{gcc} as
+@file{/usr/local/bin/gcc},
+leaving an older, non-Fortran-aware version in @file{/usr/bin/gcc}.
+(Or, the opposite happens.)@ 
+This can result in @code{g77} being unable to compile Fortran
+source files, because when it calls on @code{gcc} to do the
+actual compilation, @code{gcc} complains that it does not
+recognize the language, or the file name suffix.
+
+So, determine whether @code{gcc} already is installed on your system,
+and, if so, @emph{where} it is installed, and prepare to configure the
+new version of @code{gcc} you'll be building so that it installs
+over the existing version of @code{gcc}.
+
+You might want to back up your existing copy of @file{bin/gcc}, and
+the entire @file{lib/} directory, before
+you perform the actual installation (as described in this manual).
+
+Existing @code{gcc} installations typically are
+found in @file{/usr} or @file{/usr/local}.
+If you aren't certain where the currently
+installed version of @code{gcc} and its
+related programs reside, look at the output
+of this command:
+
+@example
+gcc -v -o /tmp/delete-me -xc /dev/null -xnone
+@end example
+
+All sorts of interesting information on the locations of various
+@code{gcc}-related programs and data files should be visible
+in the output of the above command.
+(The output also is likely to include a diagnostic from
+the linker, since there's no @samp{main_()} function.)
+However, you do have to sift through it yourself; @code{gcc}
+currently provides no easy way to ask it where it is installed
+and where it looks for the various programs and data files it
+calls on to do its work.
+
+Just @emph{building} @code{g77} should not overwrite any installed
+programs---but, usually, after you build @code{g77}, you will want
+to install it, so backing up anything it might overwrite is
+a good idea.
+(This is true for any package, not just @code{g77},
+though in this case it is intentional that @code{g77} overwrites
+@code{gcc} if it is already installed---it is unusual that
+the installation process for one distribution intentionally
+overwrites a program or file installed by another distribution.)
+
+Another reason to back up the existing version first,
+or make sure you can restore it easily, is that it might be
+an older version on which other users have come to depend
+for certain behaviors.
+However, even the new version of @code{gcc} you install
+will offer users the ability to specify an older version of
+the actual compilation programs if desired, and these
+older versions need not include any @code{g77} components.
+@xref{Target Options,,Specifying Target Machine and Compiler Version,
+gcc,Using and Porting GNU CC}, for information on the @samp{-V}
+option of @code{gcc}.
+
+@node Configuring gcc
+@subsection Configuring GNU CC
+
+@code{g77} is configured automatically when you configure
+@code{gcc}.
+There are two parts of @code{g77} that are configured in two
+different ways---@code{g77}, which ``camps on'' to the
+@code{gcc} configuration mechanism, and @code{libf2c}, which
+uses a variation of the GNU @code{autoconf} configuration
+system.
+
+Generally, you shouldn't have to be concerned with
+either @code{g77} or @code{libf2c} configuration, unless
+you're configuring @code{g77} as a cross-compiler.
+In this case, the @code{libf2c} configuration, and possibly the
+@code{g77} and @code{gcc} configurations as well,
+might need special attention.
+(This also might be the case if you're porting @code{gcc} to
+a whole new system---even if it is just a new operating system
+on an existing, supported CPU.)
+
+To configure the system, see
+@ref{Installation,,Installing GNU CC,gcc,Using and Porting GNU CC},
+following the instructions for running @file{./configure}.
+Pay special attention to the @samp{--prefix=} option, which
+you almost certainly will need to specify.
+
+(Note that @code{gcc} installation information is provided
+as a straight text file in @file{gcc/INSTALL}.)
+
+The information printed by the invocation of @file{./configure}
+should show that the @file{f} directory (the Fortran language)
+has been configured.
+If it does not, there is a problem.
+
+@emph{Note:} Configuring with the @samp{--srcdir} argument is known
+to work with GNU @code{make}, but it is not known to work with
+other variants of @code{make}.
+Irix5.2 and SunOS4.1 versions of @code{make} definitely
+won't work outside the source directory at present.
+@code{g77}'s
+portion of the @file{configure} script issues a warning message
+about this when you configure for building binaries outside
+the source directory.
+
+@node Building gcc
+@subsection Building GNU CC
+@cindex building @code{gcc}
+@cindex building @code{g77}
+
+@vindex LANGUAGES
+Building @code{g77} requires building enough of @code{gcc} that
+these instructions assume you're going to build all of
+@code{gcc}, including @code{g++}, @code{protoize}, and so on.
+You can save a little time and disk space by changes the
+@samp{LANGUAGES} macro definition in @code{gcc/Makefile.in}
+or @code{gcc/Makefile}, but if you do that, you're on your own.
+One change is almost @emph{certainly} going to cause failures:
+removing @samp{c} or @samp{f77} from the definition of the
+@samp{LANGUAGES} macro.
+
+After configuring @code{gcc}, which configures @code{g77} and
+@code{libf2c} automatically, you're ready to start the actual
+build by invoking @code{make}.
+
+@pindex configure
+@emph{Note:} You @strong{must} have run @file{./configure}
+before you run @code{make}, even if you're
+using an already existing @code{gcc} development directory, because
+@file{./configure} does the work to recognize that you've added
+@code{g77} to the configuration.
+
+There are two general approaches to building GNU CC from
+scratch:
+
+@table @dfn
+@item bootstrap
+This method uses minimal native system facilities to
+build a barebones, unoptimized @code{gcc}, that is then
+used to compile (``bootstrap'') the entire system.
+
+@item straight
+This method assumes a more complete native system
+exists, and uses that just once to build the entire
+system.
+@end table
+
+On all systems without a recent version of @code{gcc}
+already installed, the @i{bootstrap} method must be
+used.
+In particular, @code{g77} uses extensions to the C
+language offered, apparently, only by @code{gcc}.
+
+On most systems with a recent version of @code{gcc}
+already installed, the @i{straight} method can be
+used.
+This is an advantage, because it takes less CPU time
+and disk space for the build.
+However, it does require that the system have fairly
+recent versions of many GNU programs and other
+programs, which are not enumerated here.
+
+@menu
+* Bootstrap Build::  For all systems.
+* Straight Build::   For systems with a recent version of @code{gcc}.
+@end menu
+
+@node Bootstrap Build
+@subsubsection Bootstrap Build
+@cindex bootstrap build
+@cindex build, bootstrap
+
+A complete bootstrap build is done by issuing a command
+beginning with @samp{make bootstrap @dots{}}, as
+described in @ref{Installation,,Installing GNU CC,
+gcc,Using and Porting GNU CC}.
+This is the most reliable form of build, but it does require
+the most disk space and CPU time, since the complete system
+is built twice (in Stages 2 and 3), after an initial build
+(during Stage 1) of a minimal @code{gcc} compiler using
+the native compiler and libraries.
+
+You might have to, or want to, control the way a bootstrap
+build is done by entering the @code{make} commands to build
+each stage one at a time, as described in the @code{gcc}
+manual.
+For example, to save time or disk space, you might want
+to not bother doing the Stage 3 build, in which case you
+are assuming that the @code{gcc} compiler you have built
+is basically sound (because you are giving up the opportunity
+to compare a large number of object files to ensure they're
+identical).
+
+To save some disk space during installation, after Stage 2
+is built, you can type @samp{rm -fr stage1} to remove the
+binaries built during Stage 1.
+
+@emph{Note:} @xref{Object File Differences}, for information on
+expected differences in object files produced during Stage 2 and
+Stage 3 of a bootstrap build.
+These differences will be encountered as a result of using
+the @samp{make compare} or similar command sequence recommended
+by the GNU CC installation documentation.
+
+Also, @xref{Installation,,Installing GNU CC,gcc,Using and Porting GNU CC},
+for important information on building @code{gcc} that is
+not described in this @code{g77} manual.
+For example, explanations of diagnostic messages
+and whether they're expected, or indicate trouble,
+are found there.
+
+@node Straight Build
+@subsubsection Straight Build
+@cindex straight build
+@cindex build, straight
+
+If you have a recent version of @code{gcc}
+already installed on your system, and if you're
+reasonably certain it produces code that is
+object-compatible with the version of @code{gcc}
+you want to build as part of building @code{g77},
+you can save time and disk space by doing a straight
+build.
+
+To build just the C and Fortran compilers and the
+necessary run-time libraries, issue the following
+command:
+
+@example
+make -k CC=gcc LANGUAGES=f77 all g77
+@end example
+
+(The @samp{g77} target is necessary because the @code{gcc}
+build procedures apparently do not automatically build
+command drivers for languages in subdirectories.
+It's the @samp{all} target that triggers building
+everything except, apparently, the @code{g77} command
+itself.)
+
+If you run into problems using this method, you have
+two options:
+
+@itemize @bullet
+@item
+Abandon this approach and do a bootstrap build.
+
+@item
+Try to make this approach work by diagnosing the
+problems you're running into and retrying.
+@end itemize
+
+Especially if you do the latter, you might consider
+submitting any solutions as bug/fix reports.
+@xref{Trouble,,Known Causes of Trouble with GNU Fortran}.
+
+However, understand that many problems preventing a
+straight build from working are not @code{g77} problems,
+and, in such cases, are not likely to be addressed in
+future versions of @code{g77}.
+
+@node Pre-installation Checks
+@subsection Pre-installation Checks
+@cindex pre-installation checks
+@cindex installing, checking before
+
+Before installing the system, which includes installing
+@code{gcc}, you might want to do some minimum checking
+to ensure that some basic things work.
+
+Here are some commands you can try, and output typically
+printed by them when they work:
+
+@example
+sh# @kbd{cd /usr/src/gcc}
+sh# @kbd{./g77 --driver=./xgcc -B./ -v}
+g77 version 0.5.21
+ ./xgcc -B./ -v -fnull-version -o /tmp/gfa18047 @dots{}
+Reading specs from ./specs
+gcc version 2.7.2.2.f.3
+ ./cpp -lang-c -v -isystem ./include -undef @dots{}
+GNU CPP version 2.7.2.2.f.3 (Linux/Alpha)
+#include "..." search starts here:
+#include <...> search starts here:
+ ./include
+ /usr/local/include
+ /usr/alpha-unknown-linux/include
+ /usr/lib/gcc-lib/alpha-unknown-linux/2.7.2.2.f.3/include
+ /usr/include
+End of search list.
+ ./f771 /tmp/cca18048.i -fset-g77-defaults -quiet -dumpbase @dots{}
+GNU F77 version 2.7.2.2.f.3 (Linux/Alpha) compiled @dots{}
+GNU Fortran Front End version 0.5.21 compiled: @dots{}
+ as -nocpp -o /tmp/cca180481.o /tmp/cca18048.s
+ ld -G 8 -O1 -o /tmp/gfa18047 /usr/lib/crt0.o -L. @dots{}
+__G77_LIBF77_VERSION__: 0.5.21
+@@(#)LIBF77 VERSION 19970404
+__G77_LIBI77_VERSION__: 0.5.21
+@@(#) LIBI77 VERSION pjw,dmg-mods 19970527
+__G77_LIBU77_VERSION__: 0.5.21
+@@(#) LIBU77 VERSION 19970609
+sh# @kbd{./xgcc -B./ -v -o /tmp/delete-me -xc /dev/null -xnone}
+Reading specs from ./specs
+gcc version 2.7.2.2.f.3
+ ./cpp -lang-c -v -isystem ./include -undef @dots{}
+GNU CPP version 2.7.2.2.f.3 (Linux/Alpha)
+#include "..." search starts here:
+#include <...> search starts here:
+ ./include
+ /usr/local/include
+ /usr/alpha-unknown-linux/include
+ /usr/lib/gcc-lib/alpha-unknown-linux/2.7.2.2.f.3/include
+ /usr/include
+End of search list.
+ ./cc1 /tmp/cca18063.i -quiet -dumpbase null.c -version @dots{}
+GNU C version 2.7.2.2.f.3 (Linux/Alpha) compiled @dots{}
+ as -nocpp -o /tmp/cca180631.o /tmp/cca18063.s
+ ld -G 8 -O1 -o /tmp/delete-me /usr/lib/crt0.o -L. @dots{}
+/usr/lib/crt0.o: In function `__start':
+crt0.S:110: undefined reference to `main'
+/usr/lib/crt0.o(.lita+0x28): undefined reference to `main'
+sh#
+@end example
+
+(Note that long lines have been truncated, and @samp{@dots{}}
+used to indicate such truncations.)
+
+The above two commands test whether @code{g77} and @code{gcc},
+respectively, are able to compile empty (null) source files,
+whether invocation of the C preprocessor works, whether libraries
+can be linked, and so on.
+
+If the output you get from either of the above two commands
+is noticeably different, especially if it is shorter or longer
+in ways that do not look consistent with the above sample
+output, you probably should not install @code{gcc} and @code{g77}
+until you have investigated further.
+
+For example, you could try compiling actual applications and
+seeing how that works.
+(You might want to do that anyway, even if the above tests
+work.)
+
+To compile using the not-yet-installed versions of @code{gcc}
+and @code{g77}, use the following commands to invoke them.
+
+To invoke @code{g77}, type:
+
+@example
+/usr/src/gcc/g77 --driver=/usr/src/gcc/xgcc -B/usr/src/gcc/ @dots{}
+@end example
+
+To invoke @code{gcc}, type:
+
+@example
+/usr/src/gcc/xgcc -B/usr/src/gcc/ @dots{}
+@end example
+
+@node Installation of Binaries
+@subsection Installation of Binaries
+@cindex installation of binaries
+@cindex @code{g77}, installation of
+@cindex @code{gcc}, installation of
+
+After configuring, building, and testing @code{g77} and @code{gcc},
+when you are ready to install them on your system, type:
+
+@example
+make -k CC=gcc LANGUAGES=f77 install
+@end example
+
+As described in @ref{Installation,,Installing GNU CC,
+gcc,Using and Porting GNU CC}, the values for
+the @samp{CC} and @samp{LANGUAGES} macros should
+be the same as those you supplied for the build
+itself.
+
+So, the details of the above command might vary
+if you used a bootstrap build (where you might be
+able to omit both definitions, or might have to
+supply the same definitions you used when building
+the final stage) or if you deviated from the
+instructions for a straight build.
+
+If the above command does not install @file{libf2c.a}
+as expected, try this:
+
+@example
+make -k @dots{} install install-libf77 install-f2c-all
+@end example
+
+We don't know why some non-GNU versions of @code{make} sometimes
+require this alternate command, but they do.
+(Remember to supply the appropriate definitions for @samp{CC} and
+@samp{LANGUAGES} where you see @samp{@dots{}} in the above command.)
+
+Note that using the @samp{-k} option tells @code{make} to
+continue after some installation problems, like not having
+@code{makeinfo} installed on your system.
+It might not be necessary for your system.
+
+@node Updating Documentation
+@subsection Updating Your Info Directory
+@cindex updating info directory
+@cindex info, updating directory
+@cindex directory, updating info
+@pindex /usr/info/dir
+@pindex g77.info
+@cindex texinfo
+@cindex documentation
+
+As part of installing @code{g77}, you should make sure users
+of @code{info} can easily access this manual on-line.
+Do this by making sure a line such as the following exists
+in @file{/usr/info/dir}, or in whatever file is the top-level
+file in the @code{info} directory on your system (perhaps
+@file{/usr/local/info/dir}:
+
+@example
+* g77: (g77).           The GNU Fortran programming language.
+@end example
+
+If the menu in @file{dir} is organized into sections, @code{g77}
+probably belongs in a section with a name such as one of
+the following:
+
+@itemize @bullet
+@item
+Fortran Programming
+
+@item
+Writing Programs
+
+@item
+Programming Languages
+
+@item
+Languages Other Than C
+
+@item
+Scientific/Engineering Tools
+
+@item
+GNU Compilers
+@end itemize
+
+@node Missing bison?
+@subsection Missing @code{bison}?
+@cindex @code{bison}
+@cindex missing @code{bison}
+
+If you cannot install @code{bison}, make sure you have started
+with a @emph{fresh} distribution of @code{gcc}, do @emph{not}
+do @samp{make maintainer-clean} (in other versions of @code{gcc},
+this was called @samp{make realclean}), and, to ensure that
+@code{bison} is not invoked by @code{make} during the build,
+type these commands:
+
+@example
+sh# @kbd{cd gcc}
+sh# @kbd{touch bi-parser.c bi-parser.h c-parse.c c-parse.h cexp.c}
+sh# @kbd{touch cp/parse.c cp/parse.h objc-parse.c}
+sh#
+@end example
+
+These commands update the date-time-modified information for
+all the files produced by the various invocations of @code{bison}
+in the current versions of @code{gcc}, so that @code{make} no
+longer believes it needs to update them.
+All of these files should already exist in a @code{gcc}
+distribution, but the application of patches to upgrade
+to a newer version can leave the modification information
+set such that the @code{bison} input files look more ``recent''
+than the corresponding output files.
+
+@emph{Note:} New versions of @code{gcc} might change the set of
+files it generates by invoking @code{bison}---if you cannot figure
+out for yourself how to handle such a situation, try an
+older version of @code{gcc} until you find someone who can
+(or until you obtain and install @code{bison}).
+
+@node Missing makeinfo?
+@subsection Missing @code{makeinfo}?
+@cindex @code{makeinfo}
+@cindex missing @code{makeinfo}
+
+If you cannot install @code{makeinfo}, either use the @code{-k} option when
+invoking make to specify any of the @samp{install} or related targets,
+or specify @samp{MAKEINFO=echo} on the @code{make} command line.
+
+If you fail to do one of these things, some files, like @file{libf2c.a},
+might not be installed, because the failed attempt by @code{make} to
+invoke @code{makeinfo} causes it to cancel any further processing.
+
+@node Distributing Binaries
+@section Distributing Binaries
+@cindex binaries, distributing
+@cindex code, distributing
+
+If you are building @code{g77} for distribution to others in binary form,
+first make sure you are aware of your legal responsibilities (read
+the file @file{gcc/COPYING} thoroughly).
+
+Then, consider your target audience and decide where @code{g77} should
+be installed.
+
+For systems like GNU/Linux that have no native Fortran compiler (or
+where @code{g77} could be considered the native compiler for Fortran and
+@code{gcc} for C, etc.), you should definitely configure
+@code{g77} for installation
+in @file{/usr/bin} instead of @file{/usr/local/bin}.
+Specify the
+@samp{--prefix=/usr} option when running @file{./configure}.
+You might
+also want to set up the distribution so the @code{f77} command is a
+link to @code{g77}---just make an empty file named @file{f77-install-ok} in
+the source or build directory (the one in which the @file{f} directory
+resides, not the @file{f} directory itself) when you specify one of the
+@file{install} or @file{uninstall} targets in a @code{make} command.
+
+For a system that might already have @code{f2c} installed, you definitely
+will want to make another empty file (in the same directory) named
+either @file{f2c-exists-ok} or @file{f2c-install-ok}.
+Use the former if you
+don't want your distribution to overwrite @code{f2c}-related files in existing
+systems; use the latter if you want to improve the likelihood that
+users will be able to use both @code{f2c} and @code{g77} to compile code for a
+single program without encountering link-time or run-time
+incompatibilities.
+
+(Make sure you clearly document, in the ``advertising'' for
+your distribution, how installation of your distribution will
+affect existing installations of @code{gcc}, @code{f2c},
+@code{f77}, @file{libf2c.a}, and so on.
+Similarly, you should clearly document any requirements
+you assume are met by users of your distribution.)
+
+For other systems with native @code{f77} (and @code{cc}) compilers,
+configure @code{g77} as you (or most of your audience) would
+configure @code{gcc} for their installations.
+Typically this is for installation in
+@file{/usr/local}, and would not include a copy of
+@code{g77} named @code{f77}, so
+users could still use the native @code{f77}.
+
+In any case, for @code{g77} to work properly, you @strong{must} ensure
+that the binaries you distribute include:
+
+@table @file
+@item bin/g77
+This is the command most users use to compile Fortran.
+
+@item bin/gcc
+This is the command all users use to compile Fortran, either
+directly or indirectly via the @code{g77} command.
+The @file{bin/gcc} executable file must have been built
+from a @code{gcc} source tree into which a @code{g77} source
+tree was merged and configured, or it will not know how
+to compile Fortran programs.
+
+@item bin/f77
+In installations with no non-GNU native Fortran
+compiler, this is the same as @file{bin/g77}.
+Otherwise, it should be omitted from the distribution,
+so the one on already on a particular system does
+not get overwritten.
+
+@item info/g77.info*
+This is the documentation for @code{g77}.
+If it is not included, users will have trouble understanding
+diagnostics messages and other such things, and will send
+you a lot of email asking questions.
+
+Please edit this documentation (by editing @file{gcc/f/*.texi}
+and doing @samp{make doc} from the @file{/usr/src/gcc} directory)
+to reflect any changes you've made to @code{g77}, or at
+least to encourage users of your binary distribution to
+report bugs to you first.
+
+Also, whether you distribute binaries or install @code{g77}
+on your own system, it might be helpful for everyone to
+add a line listing this manual by name and topic to the
+top-level @code{info} node in @file{/usr/info/dir}.
+That way, users can find @code{g77} documentation more
+easily.
+@xref{Updating Documentation,,Updating Your Info Directory}.
+
+@item man/man1/g77.1
+This is the short man page for @code{g77}.
+It is out of date, but you might as well include it
+for people who really like man pages.
+
+@item man/man1/f77.1
+In installations where @code{f77} is the same as @code{g77},
+this is the same as @file{man/man1/g77.1}.
+Otherwise, it should be omitted from the distribution,
+so the one already on a particular system does not
+get overwritten.
+
+@item lib/gcc-lib/@dots{}/f771
+This is the actual Fortran compiler.
+
+@item lib/gcc-lib/@dots{}/libf2c.a
+This is the run-time library for @code{g77}-compiled programs.
+@end table
+
+Whether you want to include the slightly updated (and possibly
+improved) versions of @code{cc1}, @code{cc1plus}, and whatever other
+binaries get rebuilt with the changes the GNU Fortran distribution
+makes to the GNU back end, is up to you.
+These changes are
+highly unlikely to break any compilers, and it is possible
+they'll fix back-end bugs that can be demonstrated using front
+ends other than GNU Fortran's.
+
+Please assure users that unless
+they have a specific need for their existing,
+older versions of @code{gcc} command,
+they are unlikely to experience any problems by overwriting
+it with your version---though they could certainly protect
+themselves by making backup copies first!
+Otherwise, users might try and install your binaries
+in a ``safe'' place, find they cannot compile Fortran
+programs with your distribution (because, perhaps, they're
+picking up their old version of the @code{gcc} command,
+which does not recognize Fortran programs), and assume
+that your binaries (or, more generally, GNU Fortran
+distributions in general) are broken, at least for their
+system.
+
+Finally, @strong{please} ask for bug reports to go to you first, at least
+until you're sure your distribution is widely used and has been
+well tested.
+This especially goes for those of you making any
+changes to the @code{g77} sources to port @code{g77}, e.g. to OS/2.
+@email{fortran@@gnu.ai.mit.edu} has received a fair number of bug
+reports that turned out to be problems with other peoples' ports
+and distributions, about which nothing could be done for the
+user.
+Once you are quite certain a bug report does not involve
+your efforts, you can forward it to us.
diff --git a/gcc/f/install0.texi b/gcc/f/install0.texi
new file mode 100644
index 00000000000..cfb59bf0219
--- /dev/null
+++ b/gcc/f/install0.texi
@@ -0,0 +1,14 @@
+@setfilename INSTALL
+@set INSTALLONLY
+
+@c The immediately following lines apply to the INSTALL file
+@c which is generated using this file.
+This file contains installation information for the GNU Fortran compiler.
+Copyright (C) 1995, 1996 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 Installing GNU Fortran
+@include install.texi
+@bye
diff --git a/gcc/f/intdoc.c b/gcc/f/intdoc.c
new file mode 100644
index 00000000000..ff9a6f9bb4f
--- /dev/null
+++ b/gcc/f/intdoc.c
@@ -0,0 +1,1339 @@
+/* intdoc.c
+   Copyright (C) 1997 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 "assert.j"		/* Use gcc's assert.h. */
+#include <stdio.h>
+#include <stddef.h>
+#include <stdlib.h>
+#include <string.h>
+#define FFEINTRIN_DOC 1
+#include "intrin.h"
+
+typedef enum
+  {
+#if !defined(false) || !defined(true)
+    false = 0, true = 1,
+#endif
+#if !defined(FALSE) || !defined(TRUE)
+    FALSE = 0, TRUE = 1,
+#endif
+    Doggone_Trailing_Comma_Dont_Work = 1
+  } bool;
+
+#define ARRAY_SIZE(a) (sizeof(a)/sizeof(a[0]))
+
+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, char *name, char *name_uc,
+		     ffeintrinGen gen);
+static void dumpspec (int menu, char *name, char *name_uc,
+		      ffeintrinSpec spec);
+static void dumpimp (int menu, char *name, char *name_uc, size_t genno, ffeintrinFamily family,
+		     ffeintrinImp imp, ffeintrinSpec spec);
+static char *argument_info_ptr (ffeintrinImp imp, int argno);
+static char *argument_info_string (ffeintrinImp imp, int argno);
+static char *argument_name_ptr (ffeintrinImp imp, int argno);
+static char *argument_name_string (ffeintrinImp imp, int argno);
+#if 0
+static char *elaborate_if_complex (ffeintrinImp imp, int argno);
+static char *elaborate_if_maybe_complex (ffeintrinImp imp, int argno);
+static char *elaborate_if_real (ffeintrinImp imp, int argno);
+#endif
+static void print_type_string (char *c);
+
+int
+main (int argc, char **argv __attribute__ ((unused)))
+{
+  if (argc != 1)
+    {
+      fprintf (stderr, "\
+Usage: intdoc > intdoc.texi
+  Collects and dumps documentation on g77 intrinsics
+  to the file named intdoc.texi.\n");
+      exit (1);
+    }
+
+  dumpem ();
+  return 0;
+}
+
+struct _ffeintrin_name_
+  {
+    char *name_uc;
+    char *name_lc;
+    char *name_ic;
+    ffeintrinGen generic;
+    ffeintrinSpec specific;
+  };
+
+struct _ffeintrin_gen_
+  {
+    char *name;			/* Name as seen in program. */
+    ffeintrinSpec specs[2];
+  };
+
+struct _ffeintrin_spec_
+  {
+    char *name;			/* Uppercase name as seen in source code,
+				   lowercase if no source name, "none" if no
+				   name at all (NONE case). */
+    bool is_actualarg;		/* Ok to pass as actual arg if -pedantic. */
+    ffeintrinFamily family;
+    ffeintrinImp implementation;
+  };
+
+struct _ffeintrin_imp_
+  {
+    char *name;			/* Name of implementation. */
+#if 0	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
+    ffecomGfrt gfrt;		/* gfrt index in library. */
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
+    char *control;
+  };
+
+static 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)
+#include "intrin.def"
+#undef DEFNAME
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+};
+
+static 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)
+#include "intrin.def"
+#undef DEFNAME
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+};
+
+static struct _ffeintrin_imp_ imps[] = {
+#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
+#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
+#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
+#if 0	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
+#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \
+  { NAME, FFECOM_gfrt ## GFRT, CONTROL },
+#elif 1	/* FFECOM_targetCURRENT == FFECOM_targetFFE */
+#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \
+  { NAME, CONTROL },
+#else
+#error
+#endif
+#include "intrin.def"
+#undef DEFNAME
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+};
+
+static 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)
+#include "intrin.def"
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+};
+
+struct cc_pair { ffeintrinImp imp; char *text; };
+
+static char *descriptions[FFEINTRIN_imp] = { 0 };
+static struct cc_pair cc_descriptions[] = {
+#define DEFDOC(IMP,SUMMARY,DESCRIPTION) { FFEINTRIN_imp ## IMP, DESCRIPTION },
+#include "intdoc.h"
+#undef DEFDOC
+};
+
+static char *summaries[FFEINTRIN_imp] = { 0 };
+static struct cc_pair cc_summaries[] = {
+#define DEFDOC(IMP,SUMMARY,DESCRIPTION) { FFEINTRIN_imp ## IMP, SUMMARY },
+#include "intdoc.h"
+#undef DEFDOC
+};
+
+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 ()
+{
+  in_ifset = 2;
+}
+
+static void
+dumpclearif ()
+{
+  if ((in_ifset == 2)
+      || (latest_family != FFEINTRIN_familyNONE))
+    printf ("@end ifset\n");
+  latest_family = FFEINTRIN_familyNONE;
+  in_ifset = 0;
+}
+
+static void
+dumpem ()
+{
+  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 ("@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, char *name, char *name_uc, ffeintrinGen gen)
+{
+  size_t i;
+  int total;
+
+  if (!menu)
+    {
+      for (total = 0, 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, char *name, 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, char *name, char *name_uc, size_t genno, ffeintrinFamily family, ffeintrinImp imp,
+	 ffeintrinSpec spec)
+{
+  char *c;
+  bool subr;
+  char *argc;
+  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);
+	  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] == '@')
+		  && (c[1] >= '0')
+	      && (c[1] <= '9'))
+		{
+		  int argno = c[1] - '0';
+
+		  c += 2;
+		  while ((c[0] >= '0')
+			 && (c[0] <= '9'))
+		    {
+		      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 ("
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL %s} to use this name for an
+external procedure.
+
+",
+	      name);
+      return;
+    }
+
+  c = imps[imp].control;
+  subr = (c[0] == '-');
+  colon = (c[2] == ':') ? 2 : 3;
+
+  printf ("
+@noindent
+@example
+%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 (")
+@end example\n
+");
+
+  if (!subr)
+    {
+      int other_arg;
+      char *arg_string;
+      char *arg_info;
+
+      if ((c[colon + 1] >= '0')
+	  && (c[colon + 1] <= '9'))
+	{
+	  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
+%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 (".
+The exact type is @samp{REAL(KIND=1)} when argument @var{%s} is
+any type other than @code{COMPLEX}, or when it is @code{COMPLEX(KIND=1)}.
+When @var{%s} 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.\n\n",
+		    arg_string,
+		    arg_string);
+	  else
+	    printf (".
+This intrinsic is valid when argument @var{%s} is
+@code{COMPLEX(KIND=1)}.
+When @var{%s} is any other @code{COMPLEX} type,
+this intrinsic is valid only when used as the argument to
+@code{REAL()}, as explained below.\n\n",
+		    arg_string,
+		    arg_string);
+	}
+#if 0
+      else if ((c[0] == 'I')
+	       && (c[1] == 'p'))
+	printf (", the exact type being wide enough to hold a pointer
+on the target system (typically @code{INTEGER(KIND=1)} or @code{INTEGER(KIND=4)}).\n\n");
+#endif
+      else if ((c[1] == '=')
+	       && (c[colon + 1] >= '0')
+	       && (c[colon + 1] <= '9'))
+	{
+	  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 (".
+The exact type depends on that of argument @var{%s}---if @var{%s} is
+@code{COMPLEX}, this function's type is @code{REAL}
+with the same @samp{KIND=} value as the type of @var{%s}.
+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
+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
+@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 'p':
+	      printf ("@code{INTEGER} wide enough to hold a pointer");
+	      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;
+
+	    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;
+
+	    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
+of an executable statement");
+	  break;
+
+	case 's':
+	  printf ("Signal handler (@code{INTEGER FUNCTION} or @code{SUBROUTINE})
+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
+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)
+    {
+      char *c = descriptions[imp];
+
+      printf ("\
+@noindent
+Description:
+\n");
+
+      while (c[0] != '\0')
+	{
+	  if ((c[0] == '@')
+	      && (c[1] >= '0')
+	  && (c[1] <= '9'))
+	    {
+	      int argno = c[1] - '0';
+
+	      c += 2;
+	      while ((c[0] >= '0')
+		     && (c[0] <= '9'))
+		{
+		  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 char *
+argument_info_ptr (ffeintrinImp imp, int argno)
+{
+  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 char *
+argument_info_string (ffeintrinImp imp, int argno)
+{
+  char *p;
+
+  p = argument_info_ptr (imp, argno);
+  assert (p != NULL);
+  return p;
+}
+
+static char *
+argument_name_ptr (ffeintrinImp imp, int argno)
+{
+  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 char *
+argument_name_string (ffeintrinImp imp, int argno)
+{
+  char *p;
+
+  p = argument_name_ptr (imp, argno);
+  assert (p != NULL);
+  return p;
+}
+
+static void
+print_type_string (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;
+
+	case 'p':
+	  printf ("@code{INTEGER(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 ("arg type?" == NULL);
+      break;
+    }
+}
diff --git a/gcc/f/intdoc.h b/gcc/f/intdoc.h
new file mode 100644
index 00000000000..58b4007f7d5
--- /dev/null
+++ b/gcc/f/intdoc.h
@@ -0,0 +1,2370 @@
+/* Copyright (C) 1997 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!
+
+*/
+
+/* ~~~~~ to do:
+   ALARM
+*/
+
+#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 the @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 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, "Natural logarithm.", "\
+Returns the natural logarithm of @var{@1@}, which must
+be greater than zero or, if type @code{COMPLEX}, must not
+be zero.
+
+The inverse of this function is @samp{10. ** LOG10(@var{@1@})}.
+
+@xref{Log Intrinsic}, for the natural logarithm function.
+")
+
+DEFDOC (ALOG10, "Natural logarithm (archaic).", ARCHAIC (LOG10, Log10))
+
+DEFDOC (DLOG10, "Natural 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, ATan2))
+
+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 (IDIM, IDiM))
+
+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 disgregarded.
+
+@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 disgregarded.
+
+@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 disgregarded.
+
+@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 (ISIGN, ISign))
+
+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{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{@2@}, 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{@1@}.
+
+@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}.
+
+This intrinsic is not recommended, due to the year 2000 approaching.
+@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.
+
+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{@1@},
+and the user and system components of this in @samp{@var{@2@}(1)}
+and @samp{@var{@2@}(2)} respectively.
+The value of @var{@1@} is equal to @samp{@var{@2@}(1) + @var{@2@}(2)}.
+
+Subsequent invocations of @samp{@0@()} set values based on accumulations
+since the previous invocation.
+
+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)}.
+")
+
+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{@1@},
+and the user and system components of this in @samp{@var{@2@}(1)}
+and @samp{@var{@2@}(2)} respectively.
+The value of @var{@1@} is equal to @samp{@var{@2@}(1) + @var{@2@}(2)}.
+
+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
+
+@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
+
+@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
+of day, month (in the range 1--12), and year in elements 1, 2, and 3,
+respectively.
+The year has four significant digits.
+")
+
+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--7) in @var{@2@},
+and the year in @var{@3@} (in the range 0--99).
+
+This intrinsic is not recommended, due to the year 2000 approaching.
+")
+
+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.).
+
+This intrinsic is not fully portable, such as to systems
+with 32-bit @code{INTEGER} types but supporting times
+wider than 32 bits.
+@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.).
+
+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@}.
+")
+
+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.
+
+This routine is known from Cray Fortran.
+")
+
+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.
+
+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.
+")
+
+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)}.
+")
+
+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}.
+
+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}.
+
+This intrinsic is not fully portable, such as to systems
+with 32-bit @code{INTEGER} types but supporting times
+wider than 32 bits.
+@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 may 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.", "\
+Reinitialises 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 non-zero error code otherwise upon return.
+See @code{chdir(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 (CHDIR_func, "Change directory.", "\
+Sets the current working directory to be @var{@1@}.
+Returns 0 on success or a non-zero error code.
+See @code{chdir(3)}.
+
+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 non-zero 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 may 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 non-zero 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 may 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 non-zero 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 non-zero 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
+File mode
+
+@item
+Inode number
+
+@item
+ID of device containing directory entry for file
+
+@item
+Device id (if relevant)
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size
+
+@item
+Number of blocks allocated
+@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 non-zero 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
+File mode
+
+@item
+Inode number
+
+@item
+ID of device containing directory entry for file
+
+@item
+Device id (if relevant)
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size
+
+@item
+Number of blocks allocated
+@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 non-zero 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
+File mode
+
+@item
+Inode number
+
+@item
+ID of device containing directory entry for file
+
+@item
+Device id (if relevant)
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size
+
+@item
+Number of blocks allocated
+@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 non-zero 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
+File mode
+
+@item
+Inode number
+
+@item
+ID of device containing directory entry for file
+
+@item
+Device id (if relevant)
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size
+
+@item
+Number of blocks allocated
+@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 non-zero 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
+File mode
+
+@item
+Inode number
+
+@item
+ID of device containing directory entry for file
+
+@item
+Device id (if relevant)
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size
+
+@item
+Number of blocks allocated
+@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 non-zero 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
+File mode
+
+@item
+Inode number
+
+@item
+ID of device containing directory entry for file
+
+@item
+Device id (if relevant)
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size
+
+@item
+Number of blocks allocated
+@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 non-zero 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 non-zero 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 non-zero 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 non-zero 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 non-zero 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 non-zero 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 non-zero 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 non-zero 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 non-zero 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@}.
+")
+
+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 non-zero error code
+(@code{ENOSYS} if the system does not provide @code{gethostname(2)}).
+
+This intrinsic is not available on all systems.
+")
+
+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 non-zero error code upon return
+(@code{ENOSYS} if the system does not provide @code{gethostname(2)}).
+
+This intrinsic is not available on all systems.
+
+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.
+")
+
+/* Fixme: stream I/O */
+
+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{Offset}: absolute offset if @var{@2@}=0; relative to the
+current offset if @var{@2@}=1; relative to the end of the file if
+@var{@2@}=2.
+It branches to label @var{@3@} 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{@1@} to the name of the terminal device open on logical unit
+@var{@2@} or a blank string if @var{@2@} 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{@1@} is an integer, it can be
+used to turn off handling of signal @var{@2@} or revert to its default
+action.
+See @code{signal(2)}.
+
+Note that @var{@2@} will be called using C conventions, so its value in
+Fortran terms is obtained by applying @code{%LOC()} (or @var{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.
+")
+
+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{@1@} is an integer, it can be
+used to turn off handling of signal @var{@2@} or revert to its default
+action.
+See @code{signal(2)}.
+
+Note that @var{@2@} will be called using C conventions, so its value in
+Fortran terms is obtained by applying @code{%LOC()} (or @var{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.
+")
+
+DEFDOC (KILL_func, "Signal a process.", "\
+Sends the signal specified by @var{@2@} to the process @var{@1@}.
+Returns 0 on success or a non-zero 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 non-zero 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)}.
+
+@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, as the case may be,
+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.
+")
+
diff --git a/gcc/f/intdoc.texi b/gcc/f/intdoc.texi
new file mode 100644
index 00000000000..1d961d83d92
--- /dev/null
+++ b/gcc/f/intdoc.texi
@@ -0,0 +1,10570 @@
+@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::
+@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::    Natural 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:: (Reserved for future use.)
+@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::    Natural 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::     Natural 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 the @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}.
+
+@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}; 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}; 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 non-zero error code otherwise upon return.
+See @code{chdir(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{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 non-zero error code.
+See @code{chdir(3)}.
+
+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 non-zero 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 may 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 non-zero 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 may 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(KIND=1)}; 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)}.
+
+@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{Result}, @var{STime})
+@end example
+
+@noindent
+@var{Result}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@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 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}.
+
+This intrinsic is not recommended, due to the year 2000 approaching.
+@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
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Date_and_Time} to use this name for an
+external procedure.
+
+@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}; 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}; 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{ATan2 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{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{Result}, @var{TArray})
+@end example
+
+@noindent
+@var{Result}: @code{REAL(KIND=1)}; scalar; INTENT(OUT).
+
+@noindent
+@var{TArray}: @code{REAL(KIND=1)}; DIMENSION(2); 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.
+
+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.
+
+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 may 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{Result}, @var{TArray})
+@end example
+
+@noindent
+@var{Result}: @code{REAL(KIND=1)}; scalar; INTENT(OUT).
+
+@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
+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)}.
+
+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)}.
+
+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}; 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
+
+@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
+
+@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{Offset}=0; relative to the
+current offset if @var{Offset}=1; relative to the end of the file if
+@var{Offset}=2.
+It branches to label @var{Whence} 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
+File mode
+
+@item
+Inode number
+
+@item
+ID of device containing directory entry for file
+
+@item
+Device id (if relevant)
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size
+
+@item
+Number of blocks allocated
+@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 non-zero 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
+File mode
+
+@item
+Inode number
+
+@item
+ID of device containing directory entry for file
+
+@item
+Device id (if relevant)
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size
+
+@item
+Number of blocks allocated
+@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 non-zero 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}; 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 non-zero 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 non-zero 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}.
+
+@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 non-zero error code upon return
+(@code{ENOSYS} if the system does not provide @code{gethostname(2)}).
+
+This intrinsic is not available on all systems.
+
+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{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 non-zero error code
+(@code{ENOSYS} if the system does not provide @code{gethostname(2)}).
+
+This intrinsic is not available on all systems.
+
+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
+of day, month (in the range 1--12), and year in elements 1, 2, and 3,
+respectively.
+The year has four significant digits.
+
+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--7) in @var{D},
+and the year in @var{Y} (in the range 0--99).
+
+This intrinsic is not recommended, due to the year 2000 approaching.
+
+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{IDIM()} that is specific
+to one type for @var{X} and @var{Y}.
+@xref{IDiM 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}; 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 disgregarded.
+
+@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}; 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 disgregarded.
+
+@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, as the case may be,
+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{ISIGN()} that is specific
+to one type for @var{A} and @var{B}.
+@xref{ISign 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 non-zero 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 non-zero 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 non-zero 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 non-zero 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=0)} 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 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 natural logarithm of @var{X}, which must
+be greater than zero or, if type @code{COMPLEX}, must not
+be 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
+File mode
+
+@item
+Inode number
+
+@item
+ID of device containing directory entry for file
+
+@item
+Device id (if relevant)
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size
+
+@item
+Number of blocks allocated
+@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 non-zero 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
+File mode
+
+@item
+Inode number
+
+@item
+ID of device containing directory entry for file
+
+@item
+Device id (if relevant)
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size
+
+@item
+Number of blocks allocated
+@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 non-zero 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.).
+
+This intrinsic is not fully portable, such as to systems
+with 32-bit @code{INTEGER} types but supporting times
+wider than 32 bits.
+@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.).
+
+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 non-zero 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 non-zero 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}.
+
+@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.
+
+This routine is known from Cray Fortran.
+
+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(KIND=1)}; 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.
+
+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 disgregarded.
+
+@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=1)}; 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{Number} is an integer, it can be
+used to turn off handling of signal @var{Handler} or revert to its default
+action.
+See @code{signal(2)}.
+
+Note that @var{Handler} will be called using C conventions, so its value in
+Fortran terms is obtained by applying @code{%LOC()} (or @var{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.
+
+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=1)} 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{Number} is an integer, it can be
+used to turn off handling of signal @var{Handler} or revert to its default
+action.
+See @code{signal(2)}.
+
+Note that @var{Handler} will be called using C conventions, so its value in
+Fortran terms is obtained by applying @code{%LOC()} (or @var{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.
+
+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:
+
+Reinitialises 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
+File mode
+
+@item
+Inode number
+
+@item
+ID of device containing directory entry for file
+
+@item
+Device id (if relevant)
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size
+
+@item
+Number of blocks allocated
+@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 non-zero 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
+File mode
+
+@item
+Inode number
+
+@item
+ID of device containing directory entry for file
+
+@item
+Device id (if relevant)
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size
+
+@item
+Number of blocks allocated
+@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 non-zero 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 non-zero 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 non-zero 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)}; scalar; INTENT(OUT).
+
+@noindent
+@var{Max}: @code{INTEGER(KIND=1)}; 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.
+
+@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}.
+
+This intrinsic is not fully portable, such as to systems
+with 32-bit @code{INTEGER} types but supporting times
+wider than 32 bits.
+@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)}.
+
+@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}.
+
+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{Name}, @var{Unit})
+@end example
+
+@noindent
+@var{Name}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Sets @var{Name} to 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.
+
+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 non-zero 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 non-zero 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
new file mode 100644
index 00000000000..16f36fbdb3c
--- /dev/null
+++ b/gcc/f/intrin.c
@@ -0,0 +1,2047 @@
+/* intrin.c -- Recognize references to intrinsics
+   Copyright (C) 1995-1997 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 <ctype.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_
+  {
+    char *name_uc;
+    char *name_lc;
+    char *name_ic;
+    ffeintrinGen generic;
+    ffeintrinSpec specific;
+  };
+
+struct _ffeintrin_gen_
+  {
+    char *name;			/* Name as seen in program. */
+    ffeintrinSpec specs[2];
+  };
+
+struct _ffeintrin_spec_
+  {
+    char *name;			/* Uppercase name as seen in source code,
+				   lowercase if no source name, "none" if no
+				   name at all (NONE case). */
+    bool is_actualarg;		/* Ok to pass as actual arg if -pedantic. */
+    ffeintrinFamily family;
+    ffeintrinImp implementation;
+  };
+
+struct _ffeintrin_imp_
+  {
+    char *name;			/* Name of implementation. */
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+    ffecomGfrt gfrt_direct;	/* library routine, direct-callable form. */
+    ffecomGfrt gfrt_f2c;	/* library routine, f2c-callable form. */
+    ffecomGfrt gfrt_gnu;	/* library routine, gnu-callable form. */
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
+    char *control;
+  };
+
+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 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)
+#include "intrin.def"
+#undef DEFNAME
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+};
+
+static 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)
+#include "intrin.def"
+#undef DEFNAME
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+};
+
+static struct _ffeintrin_imp_ ffeintrin_imps_[]
+=
+{
+#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
+#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
+#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \
+      { NAME, FFECOM_gfrt ## GFRTDIRECT, FFECOM_gfrt ## GFRTF2C, \
+	FFECOM_gfrt ## GFRTGNU, CONTROL },
+#elif FFECOM_targetCURRENT == FFECOM_targetFFE
+#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \
+      { NAME, CONTROL },
+#else
+#error
+#endif
+#include "intrin.def"
+#undef DEFNAME
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+};
+
+static 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)
+#include "intrin.def"
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+};
+
+
+static ffebad
+ffeintrin_check_ (ffeintrinImp imp, ffebldOp op,
+		  ffebld args, ffeinfoBasictype *xbt,
+		  ffeinfoKindtype *xkt,
+		  ffetargetCharacterSize *xsz,
+		  bool *check_intrin,
+		  ffelexToken t,
+		  bool commit)
+{
+  char *c = ffeintrin_imps_[imp].control;
+  bool subr = (c[0] == '-');
+  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;
+		    }
+		}
+	      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)
+	    {
+	      /* 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);
+    }
+
+  /* Ignore explicit trailing omitted args.  */
+
+  while ((arg != NULL) && (ffebld_head (arg) == NULL))
+    arg = ffebld_trail (arg);
+
+  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;
+	    }
+	}
+      break;
+
+    case 'C':
+      if (ffe_is_90 ())
+	need_col = TRUE;
+      kt = 1;
+      break;
+
+    case 'p':
+      kt = ffecom_pointer_kind ();
+      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;
+
+      for (arg = args;
+	   arg != NULL;
+	   arg = (c[colon + 1] == '*') ? ffebld_trail (arg) : NULL)
+	{
+	  ffebld a = ffebld_head (arg);
+	  ffeinfo i;
+	  bool anynum;
+
+	  if (a == NULL)
+	    continue;
+	  i = ffebld_info (a);
+
+	  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;
+		    }
+		}
+	      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 name to intrinsic's name.  Uses strcmp on arguments' names.	*/
+
+static int
+ffeintrin_cmp_name_ (const void *name, const void *intrinsic)
+{
+  char *uc = (char *) ((struct _ffeintrin_name_ *) intrinsic)->name_uc;
+  char *lc = (char *) ((struct _ffeintrin_name_ *) intrinsic)->name_lc;
+  char *ic = (char *) ((struct _ffeintrin_name_ *) intrinsic)->name_ic;
+
+  return ffesrc_strcmp_2c (ffe_case_intrin (), name, uc, lc, ic);
+}
+
+/* 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) lineno,
+		   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 != 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 ();
+	}
+    }
+}
+
+/* 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;
+  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 ();
+	}
+    }
+}
+
+/* Return run-time index of intrinsic implementation as direct call.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ffecomGfrt
+ffeintrin_gfrt_direct (ffeintrinImp imp)
+{
+  assert (imp < FFEINTRIN_imp);
+
+  return ffeintrin_imps_[imp].gfrt_direct;
+}
+#endif
+
+/* Return run-time index of intrinsic implementation as actual argument.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ffecomGfrt
+ffeintrin_gfrt_indirect (ffeintrinImp imp)
+{
+  assert (imp < FFEINTRIN_imp);
+
+  if (! ffe_is_f2c ())
+    return ffeintrin_imps_[imp].gfrt_gnu;
+  return ffeintrin_imps_[imp].gfrt_f2c;
+}
+#endif
+
+void
+ffeintrin_init_0 ()
+{
+  int i;
+  char *p1;
+  char *p2;
+  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 (!isascii (*p1) || !isascii (*p2) || !isascii (*p3))
+	    break;
+	  if ((isdigit (*p1) || (*p1 == '_')) && (*p1 == *p2) && (*p1 == *p3))
+	    continue;
+	  if (!isupper (*p1) || !islower (*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)
+    {
+      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')
+	  && (c[1] != 'p'))
+	{
+	  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] != '*')
+      && ((c[colon + 1] < '0')
+	  || (c[colon + 1] > '9')))
+	{
+	  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] == '*')
+	      || (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'))
+	      || ((c[2] != '*')
+		  && ((c[2] < '1')
+		      || (c[2] > '9'))
+	      && (c[2] != 'A')))
+	    {
+	      fprintf (stderr, "%s: bad arg-type\n",
+		       ffeintrin_imps_[i].name);
+	      break;
+	    }
+	  if (c[3] == '[')
+	    {
+	      if (((c[4] < '0') || (c[4] > '9'))
+		  || ((c[5] != ']')
+		      && (++c, (c[4] < '0') || (c[4] > '9')
+			  || (c[5] != ']'))))
+		{
+		  fprintf (stderr, "%s: bad arg-len\n",
+			   ffeintrin_imps_[i].name);
+		  break;
+		}
+	      c += 3;
+	    }
+	  if (c[3] == '(')
+	    {
+	      if (((c[4] < '0') || (c[4] > '9'))
+		  || ((c[5] != ')')
+		      && (++c, (c[4] < '0') || (c[4] > '9')
+			  || (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;
+	      break;
+	    }
+	  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)
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+    && (ffe_is_f2c ()
+	? (ffeintrin_imps_[ffeintrin_specs_[spec].implementation].gfrt_f2c
+	   != FFECOM_gfrt)
+	: (ffeintrin_imps_[ffeintrin_specs_[spec].implementation].gfrt_gnu
+	   != FFECOM_gfrt))
+#endif
+    && ((state == FFE_intrinsicstateENABLED)
+	|| (state == FFE_intrinsicstateHIDDEN));
+}
+
+/* Determine if name is intrinsic, return info.
+
+   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 (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.  */
+
+char *
+ffeintrin_name_generic (ffeintrinGen gen)
+{
+  assert (gen < FFEINTRIN_gen);
+  return ffeintrin_gens_[gen].name;
+}
+
+/* Return name of intrinsic implementation.  */
+
+char *
+ffeintrin_name_implementation (ffeintrinImp imp)
+{
+  assert (imp < FFEINTRIN_imp);
+  return ffeintrin_imps_[imp].name;
+}
+
+/* Return external/internal name of specific intrinsic.	 */
+
+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
new file mode 100644
index 00000000000..66ca3c0a215
--- /dev/null
+++ b/gcc/f/intrin.def
@@ -0,0 +1,3350 @@
+/* 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_impNONE
+  )
+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 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)
+     C    Like 1 (F77), except (F90), if COL is COMPLEX, uses kind type of COL
+     p    ffecom_pointer_kind_
+
+   <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
+
+   <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",	,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",		,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",	,DLOG10,,	"R2:-:X=R2")
+DEFIMP	(DMAX1,		"DMAX1",	,,,		"R2:*:A=pR2")
+DEFIMP	(DMIN1,		"DMIN1",	,,,		"R2:*:A=pR2")
+DEFIMP	(DMOD,		"DMOD",		,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",	,,,		"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=I*,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=I*,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",	,,,		"--:-:Seconds=R1w")
+DEFIMP  (CTIME_func,	"CTIME_func",	CTIME,,,	"A1*:-:STime=I*")
+DEFIMP  (CTIME_subr,	"CTIME_subr",	CTIME,,,	"--:-:Result=A1w,STime=I*")
+DEFIMP  (DATE,		"DATE",		DATE,,,		"--:-:Date=A1w")
+DEFIMP	(DBESJ0,	"DBESJ0",	L_BESJ0,,,	"R2:-:X=R2")
+DEFIMP	(DBESJ1,	"DBESJ1",	L_BESJ1,,,	"R2:-:X=R2")
+DEFIMP	(DBESJN,	"DBESJN",	L_BESJN,,,	"R2:-:N=I*,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=I*,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,,,	"--:-:Result=R1w,TArray=R1(2)w")
+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,,,	"--:-:Result=R1w,TArray=R1(2)w")
+DEFIMP	(EXIT,		"EXIT",		EXIT,,,		"--:-:Status=?I*")
+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=I*,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")
+DEFIMP  (IDATE_vxt,	"IDATE_vxt",	VXTIDATE,,,	"--:-:M=I1w,D=I1w,Y=I1w")
+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=I*")
+DEFIMP	(INT8,		"INT8",		,,,		"I2:-:A=I*")
+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",		,,,		"Ip:-: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=R1w")
+DEFIMP	(SHORT,		"SHORT",	,,,		"I6:-:A=I*")
+DEFIMP	(SIGNAL_func,	"SIGNAL_func",	L_SIGNAL,,,	"I1:-:Number=I*,Handler=s*")
+DEFIMP	(SIGNAL_subr,	"SIGNAL_subr",	L_SIGNAL,,,	"--:-:Number=I*,Handler=s*,Status=?I1w")
+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,,,	"--:-:Name=A1w,Unit=I*")
+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
new file mode 100644
index 00000000000..c19b0fd85dd
--- /dev/null
+++ b/gcc/f/intrin.h
@@ -0,0 +1,130 @@
+/* intrin.h -- Public interface for intrin.c
+   Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_intrin
+#define _H_f_intrin
+
+#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)
+#include "intrin.def"
+#undef DEFNAME
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+    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)
+#include "intrin.def"
+#undef DEFNAME
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+    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,
+#include "intrin.def"
+#undef DEFNAME
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+    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);
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ffecomGfrt ffeintrin_gfrt_direct (ffeintrinImp imp);
+ffecomGfrt ffeintrin_gfrt_indirect (ffeintrinImp imp);
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
+void ffeintrin_init_0 (void);
+#define ffeintrin_init_1()
+#define ffeintrin_init_2()
+#define ffeintrin_init_3()
+#define ffeintrin_init_4()
+bool ffeintrin_is_actualarg (ffeintrinSpec spec);
+bool ffeintrin_is_intrinsic (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);
+char *ffeintrin_name_generic (ffeintrinGen gen);
+char *ffeintrin_name_implementation (ffeintrinImp imp);
+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
diff --git a/gcc/f/lab.c b/gcc/f/lab.c
new file mode 100644
index 00000000000..772553105cc
--- /dev/null
+++ b/gcc/f/lab.c
@@ -0,0 +1,159 @@
+/* lab.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 ()
+{
+  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 ()
+{
+  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 = (ffelab) malloc_new_ks (ffe_pool_any_unit (), "FFELAB label", sizeof (*l));
+  l->next = ffelab_list_;
+#ifdef FFECOM_labelHOOK
+  l->hook = FFECOM_labelNULL;
+#endif
+  l->value = v;
+  l->firstref_line = ffewhere_line_unknown ();
+  l->firstref_col = ffewhere_column_unknown ();
+  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
new file mode 100644
index 00000000000..d79e35b85ce
--- /dev/null
+++ b/gcc/f/lab.h
@@ -0,0 +1,154 @@
+/* lab.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_lab
+#define _H_f_lab
+
+/* 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;
+#ifdef FFECOM_labelHOOK
+    ffecomLabel hook;
+#endif
+    ffelabValue value;		/* 1 through 99999, or 100000+ for temp
+				   labels. */
+    unsigned long blocknum;	/* Managed entirely by user of module. */
+    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
diff --git a/gcc/f/lang-options.h b/gcc/f/lang-options.h
new file mode 100644
index 00000000000..a0e5c80596d
--- /dev/null
+++ b/gcc/f/lang-options.h
@@ -0,0 +1,152 @@
+/* lang-options.h file for Fortran
+   Copyright (C) 1995-1997 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 `lang_options' array in gcc.c for
+   g77.  */
+
+#ifdef __STDC__	/* To be consistent with lang-specs.h.  Maybe avoid
+		   overflowing some old compiler's tables, etc. */
+
+  "-fversion",
+  "-fnull-version",
+  "-fset-g77-defaults",
+/*"-fident",*/
+/*"-fno-ident",*/
+  "-ff66",
+  "-fno-f66",
+  "-ff77",
+  "-fno-f77",
+  "-ff90",
+  "-fno-f90",
+  "-fautomatic",
+  "-fno-automatic",
+  "-fdollar-ok",
+  "-fno-dollar-ok",
+  "-ff2c",
+  "-fno-f2c",
+  "-ff2c-library",
+  "-fno-f2c-library",
+  "-ffree-form",
+  "-fno-free-form",
+  "-ffixed-form",
+  "-fno-fixed-form",
+  "-fpedantic",
+  "-fno-pedantic",
+  "-fvxt",
+  "-fno-vxt",
+  "-fugly",
+  "-fno-ugly",
+  "-fugly-args",
+  "-fno-ugly-args",
+  "-fugly-assign",
+  "-fno-ugly-assign",
+  "-fugly-assumed",
+  "-fno-ugly-assumed",
+  "-fugly-comma",
+  "-fno-ugly-comma",
+  "-fugly-complex",
+  "-fno-ugly-complex",
+  "-fugly-init",
+  "-fno-ugly-init",
+  "-fugly-logint",
+  "-fno-ugly-logint",
+  "-fxyzzy",
+  "-fno-xyzzy",
+  "-finit-local-zero",
+  "-fno-init-local-zero",
+  "-fbackslash",
+  "-fno-backslash",
+  "-femulate-complex",
+  "-fno-emulate-complex",
+  "-funderscoring",
+  "-fno-underscoring",
+  "-fsecond-underscore",
+  "-fno-second-underscore",
+  "-fintrin-case-initcap",
+  "-fintrin-case-upper",
+  "-fintrin-case-lower",
+  "-fintrin-case-any",
+  "-fmatch-case-initcap",
+  "-fmatch-case-upper",
+  "-fmatch-case-lower",
+  "-fmatch-case-any",
+  "-fsource-case-upper",
+  "-fsource-case-lower",
+  "-fsource-case-preserve",
+  "-fsymbol-case-initcap",
+  "-fsymbol-case-upper",
+  "-fsymbol-case-lower",
+  "-fsymbol-case-any",
+  "-fcase-strict-upper",
+  "-fcase-strict-lower",
+  "-fcase-initcap",
+  "-fcase-upper",
+  "-fcase-lower",
+  "-fcase-preserve",
+  "-fdcp-intrinsics-delete",
+  "-fdcp-intrinsics-hide",
+  "-fdcp-intrinsics-disable",
+  "-fdcp-intrinsics-enable",
+  "-ff2c-intrinsics-delete",
+  "-ff2c-intrinsics-hide",
+  "-ff2c-intrinsics-disable",
+  "-ff2c-intrinsics-enable",
+  "-ff90-intrinsics-delete",
+  "-ff90-intrinsics-hide",
+  "-ff90-intrinsics-disable",
+  "-ff90-intrinsics-enable",
+  "-fmil-intrinsics-delete",
+  "-fmil-intrinsics-hide",
+  "-fmil-intrinsics-disable",
+  "-fmil-intrinsics-enable",
+  "-funix-intrinsics-delete",
+  "-funix-intrinsics-hide",
+  "-funix-intrinsics-disable",
+  "-funix-intrinsics-enable",
+  "-fvxt-intrinsics-delete",
+  "-fvxt-intrinsics-hide",
+  "-fvxt-intrinsics-disable",
+  "-fvxt-intrinsics-enable",
+  "-fzeros",
+  "-fno-zeros",
+  "-fdebug-kludge",
+  "-fno-debug-kludge",
+  "-fonetrip",
+  "-fno-onetrip",
+  "-fsilent",
+  "-fno-silent",
+  "-fglobals",
+  "-fno-globals",
+  "-ftypeless-boz",
+  "-fno-typeless-boz",
+  "-Wglobals",
+  "-Wno-globals",
+/*"-Wimplicit",*/
+/*"-Wno-implicit",*/
+  "-Wsurprising",
+  "-Wno-surprising",
+/*"-Wall",*/
+/* Prefix options.  */
+  "-I",
+  "-ffixed-line-length-",
+#endif
diff --git a/gcc/f/lang-specs.h b/gcc/f/lang-specs.h
new file mode 100644
index 00000000000..1e07aaf42f5
--- /dev/null
+++ b/gcc/f/lang-specs.h
@@ -0,0 +1,96 @@
+/* lang-specs.h file for Fortran
+   Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.  */
+
+#ifdef __STDC__	/* Else stringizing of OO below won't work, but in
+		   K&R case we're not building the f77 language. */
+
+#ifdef OBJECT_SUFFIX	/* Not defined compiling gcc.c prior to 2.7.0. */
+#define OO "%O"
+#else
+#define OO ".o"
+#endif
+
+  {".F", "@f77-cpp-input"},
+  {".fpp", "@f77-cpp-input"},
+  {"@f77-cpp-input",
+     /* For f77 we want -traditional to avoid errors with, for
+	instance, mismatched '.  Also, we avoid unpleasant surprises
+	with substitution of names not prefixed by `_' by using %P
+	rather than %p (although this isn't consistent with SGI and
+	Sun f77, at least) so you test `__unix' rather than `unix'.
+	-D_LANGUAGE_FORTRAN is used by some compilers like SGI and
+	might as well be in there. */
+   "cpp -lang-c %{nostdinc*} %{C} %{v} %{A*} %{I*} %{P} %I\
+	%{C:%{!E:%eGNU C does not support -C without using -E}}\
+	%{M} %{MM} %{MD:-MD %b.d} %{MMD:-MMD %b.d} %{MG}\
+	-undef -D__GNUC__=%v1 -D__GNUC_MINOR__=%v2\
+	%{ansi:-trigraphs -$ -D__STRICT_ANSI__}\
+	%{!undef:%P} -D_LANGUAGE_FORTRAN %{trigraphs} \
+	%c %{O*:%{!O0:-D__OPTIMIZE__}} -traditional\
+	%{g*} %{W*} %{w} %{pedantic*} %{H} %{d*} %C %{D*} %{U*} %{i*} %Z\
+	%i %{!M:%{!MM:%{!E:%{!pipe:%g.i}}}}%{E:%W{o*}}%{M:%W{o*}}%{MM:%W{o*}} |\n",
+   "%{!M:%{!MM:%{!E:f771 %{!pipe:%g.i} -fset-g77-defaults %(f771) \
+		   %{!Q:-quiet} -dumpbase %b.F %{d*} %{m*} %{a}\
+		   %{g*} %{O*} %{W*} %{w} %{pedantic*} \
+		   %{v:-version -fversion} %{pg:-p} %{p} %{f*} %{I*}\
+		   %{aux-info*}\
+		   %{pg:%{fomit-frame-pointer:%e-pg and -fomit-frame-pointer are incompatible}}\
+		   %{S:%W{o*}%{!o*:-o %b.s}}%{!S:-o %{|!pipe:%g.s}} |\n\
+	      %{!S:as %a %Y\
+		      %{c:%W{o*}%{!o*:-o %w%b" OO "}}%{!c:-o %d%w%u" OO "}\
+		      %{!pipe:%g.s} %A\n }}}}"},
+  {".r", "@ratfor"},
+  {"@ratfor",
+   "ratfor %{C} %{v}\
+           %{C:%{!E:%eGNU C does not support -C without using -E}}\
+           %{!E:%{!pipe:-o %g.f}}%{E:%W{o*}} %i |\n",
+   "%{!E:f771 %{!pipe:%g.f} -fset-g77-defaults %(f771) \
+	   %{!Q:-quiet} -dumpbase %b.r %{d*} %{m*} %{a}\
+	   %{g*} %{O*} %{W*} %{w} %{pedantic*} \
+	   %{v:-version -fversion} %{pg:-p} %{p} %{f*} %{I*}\
+	   %{aux-info*}\
+	   %{pg:%{fomit-frame-pointer:%e-pg and -fomit-frame-pointer are incompatible}}\
+	   %{S:%W{o*}%{!o*:-o %b.s}}%{!S:-o %{|!pipe:%g.s}} |\n\
+	   %{!S:as %a %Y\
+	   %{c:%W{o*}%{!o*:-o %w%b" OO "}}%{!c:-o %d%w%u" OO "}\
+           %{!pipe:%g.s} %A\n }}"},
+  {".f", "@f77"},
+  {".for", "@f77"},
+  {"@f77",
+   "%{!M:%{!MM:%{!E:f771 %i -fset-g77-defaults %(f771) \
+		   %{!Q:-quiet} -dumpbase %b.f %{d*} %{m*} %{a}\
+		   %{g*} %{O*} %{W*} %{w} %{pedantic*}\
+		   %{v:-version -fversion} %{pg:-p} %{p} %{f*} %{I*}\
+		   %{aux-info*}\
+		   %{pg:%{fomit-frame-pointer:%e-pg and -fomit-frame-pointer are incompatible}}\
+		   %{S:%W{o*}%{!o*:-o %b.s}}%{!S:-o %{|!pipe:%g.s}} |\n\
+	      %{!S:as %a %Y\
+		      %{c:%W{o*}%{!o*:-o %w%b" OO "}}%{!c:-o %d%w%u" OO "}\
+		      %{!pipe:%g.s} %A\n }}}}"},
+
+#undef OO
+
+#endif
diff --git a/gcc/f/lex.c b/gcc/f/lex.c
new file mode 100644
index 00000000000..acb439157af
--- /dev/null
+++ b/gcc/f/lex.c
@@ -0,0 +1,4697 @@
+/* Implementation of Fortran lexer
+   Copyright (C) 1995-1997 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 <ctype.h>
+#include "top.h"
+#include "bad.h"
+#include "com.h"
+#include "lex.h"
+#include "malloc.h"
+#include "src.h"
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#include "config.j"
+#include "flags.j"
+#include "input.j"
+#include "tree.j"
+#endif
+
+#ifdef DWARF_DEBUGGING_INFO
+void dwarfout_resume_previous_source_file (register unsigned);
+void dwarfout_start_new_source_file (register char *);
+void dwarfout_define (register unsigned, register char *);
+void dwarfout_undef (register unsigned, register char *);
+#endif DWARF_DEBUGGING_INFO
+
+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);
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static int ffelex_get_directive_line_ (char **text, FILE *finput);
+static int ffelex_hash_ (FILE *f);
+#endif
+static ffewhereColumnNumber ffelex_image_char_ (int c,
+						ffewhereColumnNumber col);
+static void ffelex_include_ (void);
+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 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 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);
+    }
+#ifdef MAP_CHARACTER
+Sorry, MAP_CHARACTER is not going to work as expected in GNU Fortran,
+please contact fortran@gnu.ai.mit.edu if you wish to fund work to
+port g77 to non-ASCII machines.
+#endif
+  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
+#define warn_traditional 0
+#define flag_traditional 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':
+	  if (warn_traditional)
+	    {
+	      ffebad_start_msg_lex ("The meaning of `\\x' (at %0) varies with -traditional",
+				    FFEBAD_severityWARNING);
+	      ffelex_bad_here_ (0, line, column);
+	      ffebad_finish ();
+	    }
+
+	  if (flag_traditional)
+	    return c;
+
+	  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':
+	  if (warn_traditional)
+	    {
+	      ffebad_start_msg_lex ("The meaning of `\\a' (at %0) varies with -traditional",
+				    FFEBAD_severityWARNING);
+	      ffelex_bad_here_ (0, line, column);
+	      ffebad_finish ();
+	    }
+
+	  if (flag_traditional)
+	    return c;
+	  return TARGET_BELL;
+
+	case 'v':
+#if 0 /* Vertical tab is present in common usage compilers.  */
+	  if (flag_traditional)
+	    return c;
+#endif
+	  return TARGET_VT;
+
+	case 'e':
+	case 'E':
+	case '(':
+	case '{':
+	case '[':
+	case '%':
+	  if (pedantic)
+	    {
+	      char m[2];
+
+	      m[0] = c;
+	      m[1] = '\0';
+	      ffebad_start_msg_lex ("Non-ANSI-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';
+	      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)
+	    {
+	      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);
+	      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 ((c >= 'a' && c <= 'f')
+	  || (c >= 'A' && c <= 'F')
+	  || (c >= '0' && c <= '9'))
+	{
+	  code *= 16;
+	  if (c >= 'a' && c <= 'f')
+	    code += c - 'a' + 10;
+	  if (c >= 'A' && c <= 'F')
+	    code += c - 'A' + 10;
+	  if (c >= '0' && c <= '9')
+	    code += c - '0';
+	  if (code != 0 || count != 0)
+	    {
+	      if (count == 0)
+		firstdig = code;
+	      count++;
+	    }
+	  nonnull = 1;
+	  return EOF;
+	}
+
+      state = 0;
+
+      if (! nonnull)
+	{
+	  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)))
+	{
+	  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)))
+    {
+      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);
+}
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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);
+}
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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':
+      if (warn_traditional)
+	warning ("the meaning of `\\x' varies with -traditional");
+
+      if (flag_traditional)
+	return c;
+
+      code = 0;
+      count = 0;
+      nonnull = 0;
+      while (1)
+	{
+	  c = getc (finput);
+	  if (!(c >= 'a' && c <= 'f')
+	      && !(c >= 'A' && c <= 'F')
+	      && !(c >= '0' && c <= '9'))
+	    {
+	      *use_d = 1;
+	      *d = c;
+	      break;
+	    }
+	  code *= 16;
+	  if (c >= 'a' && c <= 'f')
+	    code += c - 'a' + 10;
+	  if (c >= 'A' && c <= 'F')
+	    code += c - 'A' + 10;
+	  if (c >= '0' && c <= '9')
+	    code += c - '0';
+	  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':
+      if (warn_traditional)
+	warning ("the meaning of `\\a' varies with -traditional");
+
+      if (flag_traditional)
+	return c;
+      return TARGET_BELL;
+
+    case 'v':
+#if 0 /* Vertical tab is present in common usage compilers.  */
+      if (flag_traditional)
+	return c;
+#endif
+      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-ANSI 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;
+}
+
+#endif
+/* A miniature version of the C front-end lexer.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static int
+ffelex_cfelex_ (ffelexToken *xtoken, FILE *finput, int c)
+{
+  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;
+	      q = (char *)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;
+
+	  switch (c)
+	    {
+	    case '\"':
+	      c = getc (finput);
+	      done = TRUE;
+	      break;
+
+	    case '\\':		/* ~~~~~ */
+	      c = ffelex_cfebackslash_ (&use_d, &d, finput);
+	      break;
+
+	    case EOF:
+	    case '\n':
+	      fatal ("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;
+		  q = (char *)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;
+}
+#endif
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffelex_file_pop_ (char *input_filename)
+{
+  if (input_file_stack->next)
+    {
+      struct file_stack *p = input_file_stack;
+      input_file_stack = p->next;
+      free (p);
+      input_file_stack_tick++;
+#ifdef DWARF_DEBUGGING_INFO
+      if (debug_info_level == DINFO_LEVEL_VERBOSE
+	  && write_symbols == DWARF_DEBUG)
+	dwarfout_resume_previous_source_file (input_file_stack->line);
+#endif /* DWARF_DEBUGGING_INFO */
+    }
+  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->name = input_filename;
+}
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffelex_file_push_ (int old_lineno, char *input_filename)
+{
+  struct file_stack *p
+    = (struct file_stack *) xmalloc (sizeof (struct file_stack));
+
+  input_file_stack->line = old_lineno;
+  p->next = input_file_stack;
+  p->name = input_filename;
+  input_file_stack = p;
+  input_file_stack_tick++;
+#ifdef DWARF_DEBUGGING_INFO
+  if (debug_info_level == DINFO_LEVEL_VERBOSE
+      && write_symbols == DWARF_DEBUG)
+    dwarfout_start_new_source_file (input_filename);
+#endif /* DWARF_DEBUGGING_INFO */
+
+  /* Now that we've pushed or popped the input stack,
+     update the name in the top element.  */
+  if (input_file_stack)
+    input_file_stack->name = input_filename;
+}
+#endif
+
+/* Prepare to finish a statement-in-progress by sending the current
+   token, if any, then setting up EOS as the current token with the
+   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_ ()
+{
+  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_ ()
+{
+  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_;
+    }
+}
+
+/* Copied from gcc/c-common.c get_directive_line.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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 = (char *)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
+	    = (char *)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)
+	    fatal ("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
+				   another one of these (or an EOF).  */
+
+      /* Handle backslash.  */
+      char_escaped = (c == '\\' && ! char_escaped);
+    }
+}
+#endif
+
+/* Handle # directives that make it through (or are generated by) the
+   preprocessor.  As much as reasonably possible, emulate the behavior
+   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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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 ((c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'))
+    {
+      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;
+#if 0	/* g77 doesn't handle pragmas, so ignores them FOR NOW. */
+#ifdef HANDLE_SYSV_PRAGMA
+	      return handle_sysv_pragma (finput, c);
+#else /* !HANDLE_SYSV_PRAGMA */
+#ifdef HANDLE_PRAGMA
+	      HANDLE_PRAGMA (finput);
+#endif /* HANDLE_PRAGMA */
+	      goto skipline;
+#endif /* !HANDLE_SYSV_PRAGMA */
+#endif /* 0 */
+	    }
+	}
+
+      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);
+
+#ifdef DWARF_DEBUGGING_INFO
+	      if ((debug_info_level == DINFO_LEVEL_VERBOSE)
+		  && (write_symbols == DWARF_DEBUG))
+		dwarfout_define (lineno, text);
+#endif /* DWARF_DEBUGGING_INFO */
+
+	      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);
+
+#ifdef DWARF_DEBUGGING_INFO
+	      if ((debug_info_level == DINFO_LEVEL_VERBOSE)
+		  && (write_symbols == DWARF_DEBUG))
+		dwarfout_undef (lineno, text);
+#endif /* DWARF_DEBUGGING_INFO */
+
+	      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 cccp.c.  */
+
+	      /* 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 (ffe_is_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))
+    {
+      int old_lineno = lineno;
+      char *old_input_filename = input_filename;
+      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.  */
+	  lineno = 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;
+	}
+
+      lineno = l;
+
+      if (ffelex_kludge_flag_)
+	input_filename = 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->name = 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_)
+	    {
+	      lineno = 1;
+	      input_filename = old_input_filename;
+	      fatal ("Use `#line ...' instead of `# ...' in first line");
+	    }
+
+	  if (num == 1)
+	    {
+	      /* Pushing to a new file.  */
+	      ffelex_file_push_ (old_lineno, 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_)
+	{
+	  lineno = 1;
+	  input_filename = old_input_filename;
+	  fatal ("Use `#line ...' instead of `# ...' in first line");
+	}
+    }
+  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;
+}
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+/* "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;
+	  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_ ()
+{
+  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);
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+  int old_lineno = lineno;
+  char *old_input_filename = input_filename;
+#endif
+
+  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);
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffelex_file_push_ (old_lineno, ffewhere_file_name (include_wherefile));
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+  if (ffelex_include_free_form_)
+    ffelex_file_free (include_wherefile, include_file);
+  else
+    ffelex_file_fixed (include_wherefile, include_file);
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffelex_file_pop_ (ffewhere_file_name (current_wf));
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+  ffewhere_file_set (current_wf, TRUE, linecount_offset);
+
+  ffecom_close_include (include_file);
+
+  if (card_length != 0)
+    {
+#ifdef REDUCE_CARD_SIZE_AFTER_BIGGY	/* Define if occasional large lines. */
+#error "need to handle possible reduction of card size here!!"
+#endif
+      assert (ffelex_card_size_ >= card_length);	/* It shrunk?? */
+      memcpy (ffelex_card_image_, card_image, card_length);
+    }
+  ffelex_card_image_[card_length] = '\0';
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+  input_filename = old_input_filename;
+  lineno = old_lineno;
+#endif
+  ffelex_linecount_current_ = linecount_current;
+  ffelex_current_wf_ = current_wf;
+  ffelex_final_nontab_column_ = final_nontab_column;
+  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_ ()
+{
+  ffelex_linecount_current_ = ffelex_linecount_next_;
+  ++ffelex_linecount_next_;
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+  ++lineno;
+#endif
+}
+
+static void
+ffelex_send_token_ ()
+{
+  ++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_ ()
+{
+  ffelexToken t;
+
+  ++ffelex_total_tokens_;
+
+  t = (ffelexToken) malloc_new_ks (malloc_pool_image (),
+				   "FFELEX token", sizeof (*t));
+  t->id_ = ffelex_token_nextid_++;
+  return t;
+}
+
+static char *
+ffelex_type_string_ (ffelexType type)
+{
+  static char *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 ()
+{
+  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;		/* Character currently under consideration. */
+  register ffewhereColumnNumber column;	/* Not really; 0 means column 1... */
+  bool disallow_continuation_line;
+  bool ignore_disallowed_continuation;
+  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);
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+  lineno = 0;
+  input_filename = ffewhere_file_name (wf);
+#endif
+  ffelex_current_wf_ = wf;
+  disallow_continuation_line = TRUE;
+  ignore_disallowed_continuation = FALSE;
+  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:	/* :::::::::::::::::::: */
+
+#ifdef REDUCE_CARD_SIZE_AFTER_BIGGY	/* Define if occasional large lines. */
+  if (ffelex_card_size_ != FFELEX_columnINITIAL_SIZE_)
+    {
+      ffelex_card_image_
+	= malloc_resize_ks (malloc_pool_image (),
+			    ffelex_card_image_,
+			    FFELEX_columnINITIAL_SIZE_ + 9,
+			    ffelex_card_size_ + 9);
+      ffelex_card_size_ = FFELEX_columnINITIAL_SIZE_;
+    }
+#endif
+
+ first_line:			/* :::::::::::::::::::: */
+
+  c = latest_char_in_file;
+  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);
+	}
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+      else if (lextype == FFELEX_typeHASH)
+	c = ffelex_hash_ (f);
+#endif
+      else if (lextype == FFELEX_typeSLASH)
+	{
+	  /* SIDE-EFFECT ABOVE HAS HAPPENED. */
+	  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;		/* Character currently under consideration. */
+  register ffewhereColumnNumber column;	/* Not really; 0 means column 1... */
+  bool continuation_line;
+  ffewhereColumnNumber continuation_column;
+  int latest_char_in_file;	/* 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);
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+  lineno = 0;
+  input_filename = ffewhere_file_name (wf);
+#endif
+  ffelex_current_wf_ = wf;
+  continuation_line = FALSE;
+  ffelex_token_->type = FFELEX_typeNONE;
+  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 == '#')
+	{
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+	  c = ffelex_hash_ (f);
+#else
+	  /* Don't skip over # line after all.  */
+	  break;
+#endif
+	}
+
+     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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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 char match[] = "# 1 \"";
+  static int kludge[ARRAY_SIZE (match) + 1];
+  int c;
+  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;
+    }
+}
+
+#endif
+void
+ffelex_init_1 ()
+{
+  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 ()
+{
+  return ffelex_names_;
+}
+
+/* Current card image, which has the master linecount number
+   ffelex_linecount_current_.  */
+
+char *
+ffelex_line ()
+{
+  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 ()
+{
+  return ffelex_card_length_;
+}
+
+/* Master line count of current card image, or 0 if no card image
+   is current.  */
+
+ffewhereLineNumber
+ffelex_line_number ()
+{
+  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)
+{
+  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 (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 (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 (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 ()
+{
+  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 (char *s, ffewhereLine l, ffewhereColumn c)
+{
+  ffelexToken t;
+
+  assert (ffelex_is_firstnamechar (*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 (char *s, ffewhereLine l, ffewhereColumn c)
+{
+  ffelexToken t;
+
+  assert (ffelex_is_firstnamechar (*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 (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;
+}
diff --git a/gcc/f/lex.h b/gcc/f/lex.h
new file mode 100644
index 00000000000..bae1147dcc5
--- /dev/null
+++ b/gcc/f/lex.h
@@ -0,0 +1,202 @@
+/* lex.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_lex
+#define _H_f_lex
+
+/* 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 <ctype.h>
+#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 (char *s, ffewhereLine l,
+					ffewhereColumn c);
+ffelexToken ffelex_token_new_eof (void);
+ffelexToken ffelex_token_new_name (char *s, ffewhereLine l,
+				   ffewhereColumn c);
+ffelexToken ffelex_token_new_names (char *s, ffewhereLine l,
+				    ffewhereColumn c);
+ffelexToken ffelex_token_new_number (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) \
+  (isalpha ((c)) || ((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
diff --git a/gcc/f/malloc.c b/gcc/f/malloc.c
new file mode 100644
index 00000000000..3b394ead563
--- /dev/null
+++ b/gcc/f/malloc.c
@@ -0,0 +1,565 @@
+/* malloc.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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"
+
+/* For systems where <stdlib.h> is missing: */
+
+void *malloc (size_t size);
+void *realloc (void *ptr, size_t size);
+
+/* 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, '/'
+#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 char *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 ()
+{
+  if (malloc_reserve_ != NULL)
+    return;
+  malloc_reserve_ = malloc (20 * 1024);	/* In case of crash, free this first. */
+  assert (malloc_reserve_ != NULL);
+}
+
+/* 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 (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;
+  size_t ss = s;
+
+#if MALLOC_DEBUG
+  assert (s == (mallocSize) ss);/* Else alloc is too big for this
+				   library/sys. */
+#endif
+
+  ptr = malloc (ss);
+  if (ptr == NULL)
+    {
+      free (malloc_reserve_);
+      assert (ptr != NULL);
+    }
+#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, 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, 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)
+{
+  size_t ss = s;
+
+#if MALLOC_DEBUG
+  assert (s == (mallocSize) ss);/* Too big if failure here. */
+#endif
+
+  ptr = realloc (ptr, ss);
+  if (ptr == NULL)
+    {
+      free (malloc_reserve_);
+      assert (ptr != NULL);
+    }
+  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
new file mode 100644
index 00000000000..3d3cd50c404
--- /dev/null
+++ b/gcc/f/malloc.h
@@ -0,0 +1,183 @@
+/* malloc.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_malloc
+#define _H_f_malloc
+
+#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, char *name,
+			  mallocSize size);
+void *malloc_new_zinpool_ (mallocPool pool, mallocType_ type, 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 (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
diff --git a/gcc/f/name.c b/gcc/f/name.c
new file mode 100644
index 00000000000..0d85863611f
--- /dev/null
+++ b/gcc/f/name.c
@@ -0,0 +1,242 @@
+/* name.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 = (ffename) 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) ())
+{
+  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) ())
+{
+  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 = (ffenameSpace) 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
new file mode 100644
index 00000000000..e73d9504aa1
--- /dev/null
+++ b/gcc/f/name.h
@@ -0,0 +1,109 @@
+/* name.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_name
+#define _H_f_name
+
+/* 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) ());
+void ffename_space_drive_symbol (ffenameSpace ns, ffesymbol (*fn) ());
+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
diff --git a/gcc/f/news.texi b/gcc/f/news.texi
new file mode 100644
index 00000000000..efb599645aa
--- /dev/null
+++ b/gcc/f/news.texi
@@ -0,0 +1,1468 @@
+@c Copyright (C) 1995-1997 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 1997-08-11
+
+@ifclear NEWSONLY
+@node News
+@chapter News About GNU Fortran
+@end ifclear
+@cindex versions, recent
+@cindex recent versions
+
+Changes made to recent versions of GNU Fortran are listed
+below, with the most recent version first.
+
+The changes are generally listed with code-generation
+bugs first, followed by compiler crashes involving valid
+code, new features, fixes to existing features, new
+diagnostics, internal improvements, and miscellany.
+This order is not strict---for example, some items
+involve a combination of these elements.
+
+@heading In 0.5.21:
+@itemize @bullet
+@item
+Fix a code-generation bug introduced by 0.5.20
+caused by loop unrolling (by specifying
+@samp{-funroll-loops} or similar).
+This bug afflicted all code compiled by
+version 2.7.2.2.f.2 of @code{gcc} (C, C++,
+Fortran, and so on).
+
+@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 @samp{-fpedantic}
+option).
+
+@item
+Fix a compiler crash that occured when an
+integer division by a constant zero is detected.
+Instead, when the @samp{-W} option is specified,
+the @code{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 @code{gcc} (C, C++,
+Fortran, and so on).
+
+@item
+Fix a compiler crash that occurred in some cases
+of procedure inlining.
+(Such cases became more frequent in 0.5.20.)
+
+@item
+Fix a compiler crash resulting from using @code{DATA}
+or similar to initialize a @code{COMPLEX} variable or
+array to zero.
+
+@item
+Fix compiler crashes involving use of @code{AND}, @code{OR},
+or @code{XOR} intrinsics.
+
+@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.
+
+@item
+Fix compiler crashes due to using the name of a some
+non-standard intrinsics (such as @samp{FTELL} or
+@samp{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.
+
+@c @code{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 @code{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 @code{g77} as a call to the @code{libf2c}
+@c routine @samp{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 @samp{G77_fputc_0},
+@c which does not conflict with the @samp{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 @samp{fputc_}, which is
+@c simply a jacket routine that calls @samp{G77_fputc_0}.
+
+@item
+Place automatic arrays on the stack, even if
+@code{SAVE} or the @samp{-fno-automatic} option
+is in effect.
+This avoids a compiler crash in some cases.
+
+@item
+New option @samp{-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 @code{g77}.
+
+@item
+New option @samp{-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 @samp{-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.
+
+@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.
+
+@item
+Improve performance of the @code{gcc} back end so
+certain complicated expressions involving @code{COMPLEX}
+arithmetic (especially multiplication) don't appear to
+take forever to compile.
+
+@item
+Fix a couple of profiling-related bugs in @code{gcc}
+back end.
+
+@item
+Integrate GNU Ada's (GNAT's) changes to the back end,
+which consist almost entirely of bug fixes.
+
+@item
+Include some other @code{gcc} fixes that seem useful in
+@code{g77}'s version of @code{gcc}.
+(See @file{gcc/ChangeLog} for details---compare it
+to that file in the vanilla @code{gcc-2.7.2.2.tar.gz}
+distribution.)
+
+@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 @samp{Status} argument.
+
+@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.
+
+@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}.
+
+@item
+Improve @code{libU77} so it is more portable.
+
+@item
+Add options @samp{-fbadu77-intrinsics-delete},
+@samp{-fbadu77-intrinsics-hide}, and so on.
+
+@item
+Fix crashes involving diagnosed or invalid code.
+
+@item
+@code{g77} and @code{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.
+
+@item
+Improve alias analysis code to properly handle
+output registers (such as the @samp{%o} registers
+on the SPARC).
+
+@item
+Add support for @code{restrict} keyword in @code{gcc}
+front end.
+
+@item
+Modify @code{make} rules and related code so that
+generation of Info documentation doesn't require
+compilation using @code{gcc}.
+
+@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)}.
+
+@item
+Warn when explicit type declaration disagrees with
+the type of an intrinsic invocation.
+
+@item
+Support @samp{*f771} entry in @code{gcc} @file{specs} file.
+
+@item
+Fix typo in @code{make} rule @samp{g77-cross}, used only for
+cross-compiling.
+
+@item
+Fix @code{libf2c} build procedure to re-archive library
+if previous attempt to archive was interrupted.
+
+@item
+Fix @code{gcc} to more easily support configuring on
+Pentium Pro (686) systems.
+
+@item
+Change @code{gcc} to unroll loops only during the last
+invocation (of as many as two invocations) of loop
+optimization.
+
+@item
+Improve handling of @samp{-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 @samp{-ff2c} in effect.
+
+@item
+Fix @code{g77} driver to recognize @samp{-fsyntax-only}
+as an option that inhibits linking, just like @samp{-c} or
+@samp{-S}, and to recognize and properly handle the
+@samp{-nostdlib}, @samp{-M}, @samp{-MM}, @samp{-nodefaultlibs},
+and @samp{-Xlinker} options.
+
+@item
+Upgrade to @code{libf2c} as of 1997-08-06.
+
+@item
+Modify @code{libf2c} to consistently and clearly diagnose
+recursive I/O (at run time).
+
+@item
+@code{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 @code{ratfor} command, available
+separately.
+
+@item
+Fix some aspects of how @code{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.
+
+@item
+Improve diagnostics.
+
+@item
+Improve documentation and indexing.
+
+@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 @code{g77}'s version of
+@code{libf2c} the suffix @samp{.netlib}.
+
+@item
+Reserve @code{INTEGER(KIND=0)} for future use.
+@end itemize
+
+@heading In 0.5.20:
+@itemize @bullet
+@item
+The @samp{-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} constants.
+Specify @samp{-ftypeless-boz} to cause such
+constants to be interpreted as typeless.
+
+(Version 0.5.19 introduced @samp{-fno-typeless-boz} and
+its inverse.)
+
+@item
+Options @samp{-ff90-intrinsics-enable} and
+@samp{-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, @samp{-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 @samp{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 @samp{ALWAYS_FLUSH} defined,
+you will have to modify @code{libf2c} accordingly before
+building it from this and future versions of @code{g77}.
+
+@item
+Dave Love's implementation of @code{libU77} has been
+added to the version of @code{libf2c} distributed with
+and built as part of @code{g77}.
+@code{g77} now knows about the routines in this library
+as intrinsics.
+
+@item
+New option @samp{-fvxt} specifies that the
+source file is written in VXT Fortran, instead of GNU Fortran.
+
+@item
+The @samp{-fvxt-not-f90} option has been deleted,
+along with its inverse, @samp{-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 @code{g77}.
+
+@item
+The @samp{-fugly} option now issues a warning, as it
+likely will be removed in a future version.
+
+(Enabling all the @samp{-fugly-*} options is unlikely
+to be feasible, or sensible, in the future,
+so users should learn to specify only those
+@samp{-fugly-*} options they really need for a
+particular source file.)
+
+@item
+The @samp{-fugly-assumed} option, introduced in
+version 0.5.19, has been changed to
+better accommodate old and new code.
+
+@item
+Make a number of fixes to the @code{g77} front end and
+the @code{gcc} back end to better support Alpha (AXP)
+machines.
+This includes providing at least one bug-fix to the
+@code{gcc} back end for Alphas.
+
+@item
+Related to supporting Alpha (AXP) machines, the @code{LOC()}
+intrinsic and @code{%LOC()} construct now return
+values of integer type that is the same width (holds
+the same number of bits) as the pointer type on the
+machine.
+
+On most machines, this won't make a difference, whereas
+on Alphas, the type these constructs return is
+@code{INTEGER*8} instead of the more common @code{INTEGER*4}.
+
+@item
+Emulate @code{COMPLEX} arithmetic in the @code{g77} front
+end, to avoid bugs in @code{complex} support in the
+@code{gcc} back end.
+New option @samp{-fno-emulate-complex}
+causes @code{g77} to revert the 0.5.19 behavior.
+
+@item
+Fix bug whereby @samp{REAL A(1)}, for example, caused
+a compiler crash if @samp{-fugly-assumed} was in effect
+and @var{A} was a local (automatic) array.
+That case is no longer affected by the new
+handling of @samp{-fugly-assumed}.
+
+@item
+Fix @code{g77} command driver so that @samp{g77 -o foo.f}
+no longer deletes @file{foo.f} before issuing other
+diagnostics, and so the @samp{-x} option is properly
+handled.
+
+@item
+Enable inlining of subroutines and functions by the @code{gcc}
+back end.
+This works as it does for @code{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.
+
+@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 @samp{-fforce-addr}
+also is specified.
+
+New options @samp{-falias-check}, @samp{-fargument-alias},
+@samp{-fargument-noalias},
+and @samp{-fno-argument-noalias-global} control the
+way @code{g77} handles potential aliasing.
+
+@item
+The @code{CONJG()} and @code{DCONJG()} intrinsics now
+are compiled in-line.
+
+@item
+The bug-fix for 0.5.19.1 has been re-done.
+The @code{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 @code{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}.)
+
+@item
+New option @samp{-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, @code{g77} uses a separate memory location
+to hold assigned statement labels.)
+
+@item
+@code{FORMAT} and @code{ENTRY} statements now are allowed to
+precede @code{IMPLICIT NONE} statements.
+
+@item
+Produce diagnostic for unsupported @code{SELECT CASE} on
+@code{CHARACTER} type, instead of crashing, at compile time.
+
+@item
+Fix crashes involving diagnosed or invalid code.
+
+@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 @code{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).
+
+@item
+Support @code{gcc} version 2.7.2.2
+(modified by @code{g77} into version 2.7.2.2.f.2),
+and remove
+support for prior versions of @code{gcc}.
+
+@item
+Upgrade to @code{libf2c} as of 1997-02-08, and
+fix up some of the build procedures.
+
+@item
+Improve general build procedures for @code{g77},
+fixing minor bugs (such as deletion of any file
+named @file{f771} in the parent directory of @code{gcc/}).
+
+@item
+Enable full support of @code{INTEGER*8} available in
+@code{libf2c} and @file{f2c.h} so that @code{f2c} users
+may make full use of its features via the @code{g77}
+version of @file{f2c.h} and the @code{INTEGER*8}
+support routines in the @code{g77} version of @code{libf2c}.
+
+@item
+Improve @code{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, @samp{gnu}, has been added
+to contain the new @code{REALPART}, @code{IMAGPART},
+and @code{COMPLEX} intrinsics.
+An old group, @samp{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
+@samp{-ff90} option specifies Fortran 90 interpretation
+or new @samp{-fugly-complex} option, in conjunction with
+@samp{-fnot-f90}, specifies @code{f2c} interpretation.
+
+@item
+Make improvements to diagnostics.
+
+@item
+Speed up compiler a bit.
+
+@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 @samp{M} for the node
+@samp{Diagnostics} in the top-level menu of
+the Info documentation.)
+@end itemize
+
+@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: @samp{CONJG()},
+@samp{DCONJG()}, @samp{CCOS()}, @samp{CDCOS()},
+@samp{CLOG()}, @samp{CDLOG()}, @samp{CSIN()}, @samp{CDSIN()},
+@samp{CSQRT()}, @samp{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 @samp{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
+
+@heading In 0.5.19:
+@itemize @bullet
+@item
+Fix @code{FORMAT} statement parsing so negative values for
+specifiers such as @samp{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 @samp{-fonetrip} option specifies FORTRAN-66-style
+one-trip @code{DO} loops.
+
+@item
+New @samp{-fno-silent} option causes names of program units
+to be printed as they are compiled, in a fashion similar to
+UNIX @code{f77} and @code{f2c}.
+
+@item
+New @samp{-fugly-assumed} option specifies that arrays
+dimensioned via @samp{DIMENSION X(1)}, for example, are to be
+treated as assumed-size.
+
+@item
+New @samp{-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 @samp{-ff66} option is a ``shorthand'' option that specifies
+behaviors considered appropriate for FORTRAN 66 programs.
+
+@item
+New @samp{-ff77} option is a ``shorthand'' option that specifies
+behaviors considered appropriate for UNIX @code{f77} programs.
+
+@item
+New @samp{-fugly-comma} and @samp{-fugly-logint} options provided
+to perform some of what @samp{-fugly} used to do.
+@samp{-fugly} and @samp{-fno-ugly} are now ``shorthand'' options,
+in that they do nothing more than enable (or disable) other
+@samp{-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 @code{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 non-zero
+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 @samp{whence} arguments.
+
+@item
+Some useless warnings from the @samp{-Wunused} option have
+been eliminated.
+
+@item
+Fix a problem building the @file{f771} executable
+on AIX systems by linking with the @samp{-bbigtoc} option.
+
+@item
+Abort configuration if @code{gcc} has not been patched
+using the patch file provided in the @samp{gcc/f/gbe/}
+subdirectory.
+
+@item
+Add options @samp{--help} and @samp{--version} to the
+@code{g77} command, to conform to GNU coding guidelines.
+Also add printing of @code{g77} version number when
+the @samp{--verbose} (@samp{-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
+
+@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, @code{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, @samp{-fzeros}, is introduced to
+enable the traditional treatment of zeros as any
+other value.
+
+@item
+With @samp{-ff90} in force, @code{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 @samp{-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 @code{gcc} back end (GBE).
+These options are @samp{-fmove-all-movables}, @samp{-freduce-all-givs},
+and @samp{-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 @code{gcc}
+also is patched to make it easier to manage installations,
+especially useful if it turns out a @code{g77} change to the
+GBE has a bug.
+
+The @code{g77}-modified version number is the @code{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 @code{gcc}, @samp{2} for the
+second, and so on.
+
+So, this introduces version 2.7.2.f.1 of @code{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 @samp{-Wsurprising}, now produced @emph{only} when both
+operators are, indeed, arithmetic (not relational/boolean).
+
+@item
+@samp{-Wsurprising} now warns about the remaining cases
+of using non-integral variables for implied-@code{DO}
+loops, instead of these being rejected unless @samp{-fpedantic}
+or @samp{-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 @code{g77} documentation, which
+supercedes @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 @samp{-fno-second-underscore} option to specify
+that, when @samp{-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 @code{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 @code{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 @code{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
+
+@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 @samp{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 @code{ld} command
+with @samp{-o /dev/null} that @code{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 @samp{mv}.
+
+@item
+Fix omission of @samp{-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 @code{g77} (the @code{fini}
+utility in particular) is properly built using the host compiler.
+
+@item
+Add new @samp{-Wsurprising} option to warn about constructs that are
+interpreted by the Fortran standard (and @code{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. @code{f2c}).
+
+@item
+Remove from @samp{-fno-pedantic} the diagnostic about @code{DO}
+with non-@code{INTEGER} index variable; issue that under
+@samp{-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 @code{gcc} version 2.7.1.
+
+@item
+Upgrade to @code{libf2c} as of 1995-11-15.
+@end itemize
+
+@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 @samp{-fno-f2c} by making these
+procedures known to @code{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} @samp{WANT_LEAD_0} to 1 to make @code{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 @code{f2c} plus @code{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 @code{gcc} back end does not support the necessary
+mechanics (and the @code{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 @code{g77} driver.
+Provide for easy selection of whether to install copy of @code{g77}
+as @code{f77} to replace the broken code.
+
+@item
+Fix @code{gcc} driver (affects @code{g77} thereby) to not
+gratuitously invoke the
+@code{f771} program (e.g. when @samp{-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 @code{gcc}/@code{g77} when
+compiling Fortran files.
+These options include @samp{-p}, @samp{-pg}, @samp{-aux-info}, @samp{-P},
+correct setting of version-number macros for preprocessing, full
+recognition of @samp{-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 @samp{unix} to contain the new intrinsics,
+and by default enable this new group.
+
+@item
+Move @code{LOC()} intrinsic out of the @samp{vxt} group to the new
+@samp{unix} group.
+
+@item
+Improve @code{g77} so that @samp{g77 -v} by itself (or with
+certain other options, including @samp{-B}, @samp{-b}, @samp{-i},
+@samp{-nostdlib}, and @samp{-V}) reports lots more useful
+version info, and so that long-form options @code{gcc} accepts are
+understood by @code{g77} as well (even in truncated, unambiguous forms).
+
+@item
+Add new @code{g77} option @samp{--driver=name} to specify driver when
+default, @code{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 @code{gcc}, with info such as
+@samp{In function `foo':} and @samp{In file included from...:}.
+
+@item
+Support @code{gcc}'s @samp{-fident} and @samp{-fno-ident} options.
+
+@item
+When @samp{-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 (@code{g77} might someday start warning about these)---applies
+to @code{gcc} versions 2.7.0 and later, since earlier versions didn't
+warn about unused dummy arguments.
+
+@item
+New option @samp{-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
+@code{g77} using the native (non-@code{gcc}) compiler on certain machines
+(but definitely not all machines nor all non-@code{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 @code{g77} is known to not work well for such cases (to be
+fixed in Version 0.6---@pxref{Actual Bugs,,Actual Bugs We Haven't Fixed Yet}).
+
+@item
+Lots of new documentation (though work is still needed to put it into
+canonical GNU format).
+
+@item
+Build @code{libf2c} with @samp{-g0}, not @samp{-g2}, in effect
+(by default), to produce
+smaller library without lots of debugging clutter.
+@end itemize
+
+@heading In 0.5.15:
+@itemize @bullet
+@item
+Fix bad code generation involving @samp{X**I} and temporary, internal variables
+generated by @code{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 @samp{-ff2c} option is in force (which it is by default) so that
+@code{f2c} compatibility is indeed provided.
+
+@item
+Disallow @samp{COMMON I(10)} if @samp{I} has previously been specified
+with an array declarator.
+
+@item
+New @samp{-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
+@samp{-ffixed-line-length-none} was in effect.
+
+@item
+No longer generate better code for some kinds of array references,
+as @code{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 @code{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 @samp{-I} option for @code{INCLUDE} statement, plus @code{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 @code{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 @code{g77}, which expects a working ANSI C
+environment (and, for now, a GNU C compiler to compile @code{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 @samp{-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 @code{f2c}'s, which supports only
+a limited subset of backslash (escape) sequences.
+
+@item
+Make @samp{-fugly-args} the default.
+
+@item
+New @samp{-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 @samp{-fno-ugly-init}.
+
+@item
+New @samp{-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 @samp{-Wimplicit} option to warn about implicitly typed variables, arrays,
+and functions.
+(Basically causes all program units to default to @code{IMPLICIT NONE}.)
+
+@item
+@samp{-Wall} now implies @samp{-Wuninitialized} as with @code{gcc}
+(i.e. unless @samp{-O} not specified, since @samp{-Wuninitialized}
+requires @samp{-O}), and implies @samp{-Wunused} as well.
+
+@item
+@samp{-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 @code{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 @code{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 --
+@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:} @code{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 @code{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 --
+@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 @code{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 @samp{-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
diff --git a/gcc/f/news0.texi b/gcc/f/news0.texi
new file mode 100644
index 00000000000..8fb85f456da
--- /dev/null
+++ b/gcc/f/news0.texi
@@ -0,0 +1,14 @@
+@setfilename NEW
+@set NEWSONLY
+
+@c The immediately following lines apply to the NEWS file
+@c which is generated using this file.
+This file lists recent changes to the GNU Fortran compiler.
+Copyright (C) 1995, 1996 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
+@include news.texi
+@bye
diff --git a/gcc/f/parse.c b/gcc/f/parse.c
new file mode 100644
index 00000000000..7a48fbb58f5
--- /dev/null
+++ b/gcc/f/parse.c
@@ -0,0 +1,93 @@
+/* GNU Fortran
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 <ctype.h>
+#include <signal.h>
+#include "top.h"
+#include "com.h"
+#include "where.h"
+#include "zzz.h"
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#include "flags.j"
+#endif
+
+#define NAME_OF_STDIN "<stdin>"
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+void
+main (int argc, char *argv[])
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+FILE *finput;
+
+int
+yyparse ()
+#else
+#error
+#endif
+{
+  ffewhereFile wf;
+
+  if (ffe_is_version ())
+    fprintf (stderr, "GNU Fortran Front End version %s compiled: %s %s\n",
+	     ffezzz_version_string,
+	     ffezzz_date,
+	     ffezzz_time);
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  ffe_init_0 ();
+
+  for (--argc, ++argv; argc > 0; --argc, ++argv)
+    {
+      if (!ffe_decode_option (argv[0]))
+	fprintf (stderr, "Unrecognized option: %s\n", argv[0]);
+    }
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  if (!ffe_is_pedantic ())
+    ffe_set_is_pedantic (pedantic);
+#else
+#error
+#endif
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  wf = ffewhere_file_new (NAME_OF_STDIN, strlen (NAME_OF_STDIN));
+  ffecom_file (NAME_OF_STDIN);
+  ffe_file (wf, stdin);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  wf = ffewhere_file_new (main_input_filename, strlen (main_input_filename));
+  ffecom_file (main_input_filename);
+  ffe_file (wf, finput);
+#else
+#error
+#endif
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffecom_finish_compile ();
+
+  return 0;
+#elif FFECOM_targetCURRENT == FFECOM_targetFFE
+  ffe_terminate_0 ();
+
+  exit (0);
+#else
+#error
+#endif
+}
diff --git a/gcc/f/proj.c b/gcc/f/proj.c
new file mode 100644
index 00000000000..0e1ef2e8bcd
--- /dev/null
+++ b/gcc/f/proj.c
@@ -0,0 +1,71 @@
+/* proj.c file for GNU Fortran
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 <ctype.h>
+#include "glimits.j"
+
+#if !FFEPROJ_STRTOUL
+unsigned long int
+strtoul (const char *nptr, char **endptr, int base)
+{
+  unsigned long int number = 0;
+  unsigned long int old_number = 0;
+
+  assert (base == 10);
+  assert (endptr == NULL);
+
+  while (isdigit (*nptr))
+    {
+      number = old_number * 10 + (*(nptr++) - '0');
+      if ((number <= old_number) && (old_number != 0))
+	return ULONG_MAX;
+      old_number = number;
+    }
+
+  return number;
+}
+
+#endif
+
+#if !FFEPROJ_BSEARCH
+void *
+bsearch (const void *key, const void *base, size_t nmemb, size_t size,
+	 int (*compar) (const void *, const void *))
+{
+  size_t i;
+  int cmp;
+
+  /* We do a dumb incremental search, not a binary search, for now. */
+
+  for (i = 0; i < nmemb; ++i)
+    {
+      if ((cmp = (*compar) (key, base)) == 0)
+	return base;
+      if (cmp < 0)
+	break;
+      base += size;
+    }
+
+  return NULL;
+}
+
+#endif
diff --git a/gcc/f/proj.h b/gcc/f/proj.h
new file mode 100644
index 00000000000..205130a49d1
--- /dev/null
+++ b/gcc/f/proj.h
@@ -0,0 +1,102 @@
+/* proj.h file for Gnu Fortran
+   Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_proj
+#define _H_f_proj
+
+#if !defined (__GNUC__) || (__GNUC__ < 2)
+#error "You have to use gcc 2.x to build g77 (might be fixed in g77-0.6)."
+#endif
+
+#ifndef BUILT_WITH_270
+#if (__GNUC__ > 2) || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7)
+#define BUILT_WITH_270 1
+#else
+#define BUILT_WITH_270 0
+#endif
+#endif	/* !defined (BUILT_WITH_270) */
+
+/* This file used to attempt to allow for all sorts of broken systems.
+   Because the auto-configuration scripts in conf-proj(.in) didn't work
+   on all systems, and I received far too many bug reports about them,
+   I decided to stop trying to cater to broken systems at all, and
+   simply remove all but the simplest and most useful code (which is
+   still in proj.c).
+
+   So, if you find your system can't link because bsearch() or strtoul()
+   aren't found, please just fix your system, or hand-edit the code
+   below as appropriate.  I DO NOT WANT ANY "BUG REPORTS" ABOUT THIS.
+   g77 requires a working ANSI C environment, and if bsearch() and strtoul()
+   do not exist, or if <assert.h> isn't found, etc., then you don't have
+   one, and it is not g77's fault.  If it turns out g77 is simply
+   referring to the wrong system header file -- something I can verify
+   myself using my copy of the ANSI C standard -- I would like to know
+   about that.  Otherwise, g77 is not the place to fix problems with your
+   ANSI C implementation, though perhaps gcc might be.
+   --  burley@gnu.ai.mit.edu 1995-03-24  */
+
+#ifndef FFEPROJ_BSEARCH
+#define FFEPROJ_BSEARCH 1	/* 0=>use slow code in proj.c. */
+#endif
+#ifndef FFEPROJ_STRTOUL
+#define FFEPROJ_STRTOUL 1	/* 0=>use untested code in proj.c. */
+#endif
+
+/* Include files everyone gets. */
+
+#include "assert.j"		/* Use gcc's assert.h. */
+#include <stdio.h>
+#include <stddef.h>
+#include <stdlib.h>
+#include <string.h>
+
+/* Generally useful definitions. */
+
+typedef enum
+  {
+#if !defined(false) || !defined(true)
+    false = 0, true = 1,
+#endif
+#if !defined(FALSE) || !defined(TRUE)
+    FALSE = 0, TRUE = 1,
+#endif
+    Doggone_Trailing_Comma_Dont_Work = 1
+  } bool;
+
+#define ARRAY_SIZE(a) (sizeof(a)/sizeof(a[0]))
+#define STR(s) # s
+#define STRX(s) STR(s)
+
+#ifndef UNUSED	/* Compile with -DUNUSED= if cc doesn't support this. */
+#if BUILT_WITH_270
+#define UNUSED __attribute__ ((unused))
+#else	/* !BUILT_WITH_270 */
+#define UNUSED
+#endif	/* !BUILT_WITH_270 */
+#endif  /* !defined (UNUSED) */
+
+#ifndef dmpout
+#define dmpout stderr
+#endif
+
+#endif
diff --git a/gcc/f/rtl.j b/gcc/f/rtl.j
new file mode 100644
index 00000000000..646e1f6a404
--- /dev/null
+++ b/gcc/f/rtl.j
@@ -0,0 +1,28 @@
+/* rtl.j -- Wrapper for GCC's rtl.h
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 MAKING_DEPENDENCIES
+#ifndef _J_f_rtl
+#define _J_f_rtl
+#include "config.j"
+#include "rtl.h"
+#endif
+#endif
diff --git a/gcc/f/runtime/ChangeLog b/gcc/f/runtime/ChangeLog
new file mode 100644
index 00000000000..f5f79c899f7
--- /dev/null
+++ b/gcc/f/runtime/ChangeLog
@@ -0,0 +1,698 @@
+Mon Aug 11 20:12:42 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* Makefile.in ($(lib), stamp-lib): Ensure that library
+	gets fully updated even if updating was aborted earlier.
+
+	* libU77/hostnm_.c (G77_hostnm_0): Return ENOSYS and stuff
+	in errno if system has no gethostname() function.
+
+	* libU77/lstat_.c (G77_lstat_0): Return ENOSYS and stuff
+	in errno if system has no lstat() function.
+
+	* libU77/getcwd_.c (G77_getcwd_0): Return ENOSYS and stuff
+	in errno if system has no getcwd() or getwd() function.
+	Test HAVE_GETCWD properly.
+
+	* libU77/symlnk_.c (G77_symlink_0): Return ENOSYS and stuff
+	in errno if system has no symlink() function.
+
+	* libU77/mclock_.c (G77_mclock_0): Return -1 if system
+	has no clock() function.
+
+Mon Aug 11 01:55:36 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* Makefile.in (F2CEXT): Add `alarm' to this list.
+
+	* f2cext.c (alarm_): Fix some typos in this function.
+	Delete third `status' argument.
+
+	* libU77/alarm_.c: Delete third `status' argument,
+	as caller gets this from function result; return
+	status value as function result for caller.
+
+	* configure.in: Rename `ac_cv_struct_FILE' to
+	`g77_cv_struct_FILE' according to 1997-06-26 change.
+
+1997-08-06  Dave Love  <d.love@dl.ac.uk>
+
+	* libU77/vxtidate_.c: Correct day/month argument order.
+	* f2cext.c: Likewise.
+
+1997-07-07  Dave Love  <d.love@dl.ac.uk>
+
+	* f2cext.c: Add alarm_.
+
+	* Makefile.in, libU77/Makefile.in: Add alarm_.
+
+	* libU77/alarm_.c: New file.
+
+1997-06-26  Dave Love  <d.love@dl.ac.uk>
+
+	* configure.in: Generally use prefix `g77_' for cached values
+	we've invented, not `ac_'.
+
+Tue Jun 24 18:50:06 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* libI77/ilnw.c (s_wsni): Call f_init() here.
+	(s_wsli): Ditto.
+	(e_wsli): Turn off "doing I/O" flag here.
+
+1997-06-20  Dave Love  <d.love@dl.ac.uk>
+
+	* runtime/configure.in: Check for cygwin32 after Mumit Khan (but
+ 	differently); if cygwin32 define NON_UNIX_STDIO and don't define
+ 	NON_ANSI_RW_MODES.
+
+Tue Jun 01 06:26:29 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* libI77/rsne.c (nl_init): Don't call f_init() here,
+	since s_rsne() already does.
+	(c_lir): Call f_init() here instead.
+	* libI77/rsli.c (e_rsli): Turn off "doing I/O" flag here.
+	* libI77/sue.c (e_rsue): Ditto.
+
+Sun Jun 22 23:27:22 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* libI77/fio.h (err): Mark I/O as no longer in progress
+	before returning a non-zero error indicator (since
+	that tells the caller to jump over the remaining I/O
+	calls, including the corresponding `e_whatever' call).
+	* libI77/err.c (endif): Ditto.
+	* libI77/sfe.c (e_wsfe): Ditto.
+	* libI77/lread.c (ERR): Ditto.
+	* libI77/lread.c (l_read): Ditto by having quad case
+	use ERR, not return, to return non-zero error code.
+
+Sat Jun 21 12:31:28 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* libI77/open.c (fk_open): Temporarily turn off
+	"doing I/O" flag during f_open() call to avoid recursive
+	I/O error.
+
+Tue Jun 17 22:40:47 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* err.c, close.c, rewind.c, inquire.c, backspace.c, endfile.c,
+	iio.c, open.c, Version.c, sfe.c, wsle.c, rsne.c, sue.c, rsfe.c,
+	lread.c, wsfe.c, fio.h, due.c, dfe.c: Change f__init from
+	`flag' to `int' and to signal not just whether initialization
+	has happened (bit 0), but also whether I/O is in progress
+	already (bit 1).  Consistently produce a clear diagnostic
+	in cases of recursive I/O.  Avoid infinite recursion in
+	f__fatal, in case sig_die triggers another error.  Don't
+	output info on internals if not initialized in f__fatal.  Don't
+	bother closing units in f_exit if initialization hasn't
+	happened.
+
+Tue Jun 10 12:57:44 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Update to Netlib version of 1997-06-09:
+	* libI77/err.c, libI77/lread.c, libI77/rdfmt.c,
+	libI77/wref.c: Move some #include's around.
+
+Mon Jun  9 18:11:56 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* libU77/kill_.c (kill_): KR_headers version needed
+	`*' in front of args in decls.
+
+Sun May 25 03:16:53 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Update to Netlib version of 1997-05-24:
+	* libF77/README, libF77/Version.c, libF77/main.c,
+	libF77/makefile, libF77/s_paus.c, libF77/signal1.h,
+	libF77/signal_.c, libF77/z_div.c, libI77/Notice,
+	libI77/README, libI77/Version.c, libI77/dfe.c,
+	libI77/err.c, libI77/fmt.c, libI77/makefile,
+	libI77/rawio.h: Apply many, but not all, of the changes
+	made to libf2c since last update.
+	* libF77/Makefile.in (MISC), Makefile.in (MISC): Rename
+	exit.o to exit_.o to go along with Netlib.
+	* libF77/signal.c: Make the prologue much simpler than
+	Netlib has it.
+
+Sun May 18 20:56:02 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* libU77/unlink_.c, libU77/stat_.c, libU77/symlnk_.c,
+	libU77/chmod_.c: g_char first arg is const.
+
+	* libU77/chmod_.c: s_cat expects ftnlen[], not int[] or
+	integer[], change types of array and variables
+	accordingly.
+
+May 7 1997  Daniel Pettet  <dan.pettet@bchydro.bc.ca>
+
+	* libU77/dbes_.c: Commented out the code in the
+	same way the bes* routines are commented out.  This
+	was done because corresponding C routines are referenced
+	directly in com-rt.def.
+
+Mon May  5 13:56:02 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* libU77/stat_.c: Reverse KR/ANSI decls of g_char().
+
+Apr 18 1997  Daniel Pettet  <dan.pettet@bchydro.bc.ca>
+
+	* libF77/F77_aloc.c, libF77/abort_.c, libF77/derf_.c,
+	libF77/derfc_.c, libF77/ef1asc_.c, libF77/ef1cmc_.c,
+	libF77/erf_.c, libF77/erfc_.c, libF77/exit.c,
+	libF77/getarg_.c, libF77/getenv_.c, libF77/iargc_.c,
+	libF77/s_cat.c, libF77/signal_.c, libF77/system_.c,
+	libI77/close.c, libI77/ftell_.c, libU77/access_.c,
+	libU77/bes.c, libU77/chdir_.c, libU77/chmod_.c, libU77/ctime_.c,
+	libU77/date_.c, libU77/dbes.c, libU77/dtime_.c, libU77/etime_.c,
+	libU77/fdate_.c, libU77/fgetc_.c, libU77/flush1_.c,
+	libU77/fnum_.c, libU77/fputc_.c, libU77/fstat_.c,
+	libU77/gerror_.c, libU77/getcwd_.c, libU77/getgid_.c,
+	libU77/getlog_.c, libU77/getpid_.c, libU77/getuid_.c,
+	libU77/gmtime_.c, libU77/hostnm_.c, libU77/idate_.c,
+	libU77/ierrno_.c, libU77/irand_.c, libU77/isatty_.c,
+	libU77/itime_.c, libU77/kill_.c, libU77/link_.c,
+	libU77/lnblnk_.c, libU77/ltime_.c, libU77/mclock_.c,
+	libU77/perror_.c, libU77/rand_.c, libU77/rename_.c,
+	libU77/secnds_.c, libU77/second_.c, libU77/sleep_.c,
+	libU77/srand_.c, libU77/stat_.c, libU77/symlnk_.c,
+	libU77/system_clock_.c, libU77/time_.c, libU77/ttynam_.c,
+	libU77/umask_.c, libU77/unlink_.c, libU77/vxtidate_.c,
+	libU77/vxttime_.c: Completed renaming routines that are directly
+	callable from g77 to internal names of the form
+	G77_xxxx_0 that are known as intrinsics by g77.
+
+Apr 8 1997  Daniel Pettet  <dan.pettet@bchydro.bc.ca>
+
+	* Makefile.in: Add libU77/mclock_.o and libU77/symlnk_.o to UOBJ.
+	* libU77/Makefile.in: Add mclock_.c to SRCS.
+	Add mclock_.o and symlnk_.o to OBJS.
+	Add mclock_.o dependency.
+
+Apr 8 1997  Daniel Pettet  <dan.pettet@bchydro.bc.ca>
+
+	* libU77/symlnk_.c: Added a couple of (char*) casts to malloc
+	to silence the compiler.
+
+1997-03-17  Dave Love  <d.love@dl.ac.uk>
+
+	* libU77/access_.c, libU77/chdir_.c, libU77/chmod_.c,
+	libU77/link_.c, libU77/lstat_.c, libU77/rename_.c, libU77/stat_.c,
+	libU77/symlnk_.c, libU77/u77-test.f, libU77/unlink_.c: Strip
+	trailing blanks from file names for consistency with other
+	implementations (notably Sun's).
+
+	* libU77/chmod_.c: Quote the file name given to the shell.
+
+Mon Mar 10 00:19:17 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* libI77/uio.c (do_ud) [PAD_UDread]: Add semicolon to err()
+	invocation when macro not defined (from Mumit Khan
+	<khan@xraylith.wisc.edu>).
+
+Fri Feb 28 13:16:50 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* Version 0.5.20 released.
+
+Wed Feb 26 20:28:53 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* Makefile.in: $(MAKE) invocations now explicitly
+	specify `-f Makefile', just in case the `makefile's
+	from the netlib distribution would get used instead.
+
+Mon Feb 24 16:43:39 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* libU77/Makefile.in (check): Specify driver, and
+	don't bother enabling already-enabled intrinsic groups.
+	Also, get the $(srcdir) version of u77-test.f.
+
+Sat Feb 22 14:08:42 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* libU77/u77-test.f: Explicitly declare intrinsics, get
+	rid of useless CHARACTER declarations on intrinsics (maybe
+	someday appropriate to implement meaning of that in g77
+	and restore them?).
+	Add spin loop just to fatten up the timings a bit.
+	Clarify ETIME output as having three fields.
+	Call TIME with CHARACTER*8, not CHARACTER*6, argument.
+	Call new SECOND intrinsic subroutine, after calling
+	new DUMDUM subroutine just to ensure the correct value
+	doesn't get left around in a register or something.
+
+Thu Feb 20 15:22:42 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* libU77/bes.c: Comment out all the code, as g77 avoids actually
+	calling it, going directly to the system's library instead.
+
+Mon Feb 17 02:27:41 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* libU77/fgetc_.c (fgetc_): Allow return value to be
+	CHARACTER*(*), properly handle CHARACTER*0 and blank-pad
+	CHARACTER*n where n>1.
+
+Tue Feb 11 14:12:19 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* Makefile.in: Clarify role of $(srcdir) here.  Fix
+	various targets accordingly.  Don't rely at all on
+	gcc/f/include/ being a link to gcc/include/ -- just
+	use it directly.
+	(${srcdir}/configure, ${srcdir}/libU77/configure):
+	Remove the config.cache files in build directory before
+	cd'ing to source directory as well.
+
+	* libF77/Makefile.in, libI77/Makefile.in (ALL_CFLAGS):
+	Include `-I.' to pick up build directory.
+	Use gcc/include/ directly.
+	* libU77/Makefile.in (ALL_CFLAGS): Include `-I$(srcdir)'
+	to pick up source directory.
+	(OBJS): Fix typo in `chmod_.o' (was `chmod.o').
+
+Mon Feb 10 12:54:47 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* Makefile.in (UOBJ), libU77/Makefile.in (OBJS): Add
+	libU77/chmod_.o to list of objects.
+	* libU77/chmod_.c: Fix up headers.
+	Fix implementation to not prematurely truncate command
+	string and make room for trailing null.
+
+	* libU77/ctime_.c: Incoming xstime argument is now longint.
+	* libU77/mclock_.c: Now returns longint.
+	* libU77/time_.c: Now returns longint.
+
+1997-02-10  Dave Love  <d.love@dl.ac.uk>
+
+	* etime_.c, dtime_.c: Typo rounded times to seconds.
+
+	* date_.c: Add missing return.
+
+	* hostnm_.c: #include unistd.h.
+
+Sat Feb  8 03:30:19 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	INTEGER*8 support built in to f2c.h and libf2c (since
+	gcc will be used to compile relevant code anyway):
+	* Makefile.in, libF77/Makefile.in: Add pow_qq.o,
+	qbitbits.o, and qbitshft.o to $POW and $F90BIT macros,
+	as appropriate.
+	* f2c.h.in: Define appropriate types and macros.
+	Place #error directive correctly.
+	* configure.in: Determine appropriate types for long
+	integer (F2C_LONGINT).
+	Meanwhile, quote strings in #error, for consistency.
+	Fix restoring of ac_cpp macro.
+	* configure: Regenerated using autoconf-2.12.
+
+	* libF77/Version.c, libI77/Version.c, libU77/Version.c:
+	Update version numbers.
+	Change names and code for g77-specific version-printing
+	routines (shorter names should be safer to link on
+	weird, 8-char systems).
+
+	* libF77/c_cos.c, libF77/c_div.c, libF77/c_exp.c,
+	libF77/c_log.c, libF77/c_sin.c, libF77/c_sqrt.c,
+	libF77/d_cnjg.c, libF77/pow_zi.c, libF77/r_cnjg.c,
+	libF77/z_cos.c, libF77/z_div.c, libF77/z_exp.c,
+	libF77/z_log.c, libF77/z_sin.c, libF77/z_sqrt.c:
+	Changed to work properly even when result is aliased
+	with any inputs.
+
+	* libF77/makefile, libI77/makefile: Leave these in
+	the g77 distribution, so it is easier to track changes
+	to official libf2c.
+
+	* libF77/signal_.c: Eliminate redundant `return 0;'.
+
+	* libI77/fio.h (err, errfl): Fix these so they work
+	(and must be expressed) as statements.
+	Fix up many users of err() to include trailing semicolon.
+
+	* Incorporate changes by Bell Labs to libf2c through 1997-02-07.
+
+1997-02-06  Dave Love  <d.love@dl.ac.uk>
+
+	* libU77/etime_.c, libU77/dtime_.c: Fix getrusage stuff.
+
+	* libU77/config.h.in: Regenerate for HAVE_GETRUSAGE.
+
+	* libU77/Makefile.in, libI77/Makefile.in, libF77/Makefile.in:
+	Redo *clean targets; distclean and maintainer-clean remove the stage?
+	and include links.  This probably want looking at further.
+
+Wed Feb  5 00:21:23 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Add libU77 library from Dave Love <d.love@dl.ac.uk>:
+	* Makefile.in: Add libU77 directory, rules, etc.
+	* configure.in: New libU77 directory, Makefile, etc.
+
+	* Makefile.in, libF77/Makefile.in, libI77/Makefile.in,
+	libU77/Makefile.in: Reorganize these so $(AR) commands
+	handled by the top-level Makefile instead of the
+	subordinates.  This permits it to do $(AR) only when
+	one or more object files actually change, instead of
+	having to force-update it as was necessary before.
+	And that had the disadvantage of requiring, e.g., user
+	root to have access to $(AR) to the library simply to
+	install g77, which might be problematic on an NFS setup.
+	(mostlyclean, clean, distclean, maintainer-clean):
+	Properly handle these rules.
+
+	* Makefile.in: Don't invoke config.status here -- let
+	compiler-level stuff handle all that.
+
+	* err.c [MISSING_FILE_ELEMS]: Declare malloc in this case
+	too, so it doesn't end up as an integer.
+
+Sat Feb  1 02:43:48 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* libF77/Makefile.in: More fixup for $(F90BIT) -- wasn't
+	in list for ar command, and it wasn't correctly listed
+	in the list of things depending on f2c.h.
+
+	* f2c.h.in: Fix up #error directive.
+
+1997-01-31  Dave Love  <d.love@dl.ac.uk>
+
+	* libF77/Makefile.in ($(lib)): Add $(F90BIT); shouldn't exclude
+	stuff f2c needs so we can share the library.
+
+Sat Jan 18 19:39:03 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* configure.in: No longer define ALWAYS_FLUSH, the
+	resulting performance is too low.
+
+Wed Dec 18 12:06:02 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Patch from Mumit Khan <khan@xraylith.wisc.edu>:
+	* libF77/s_paus.c: Add __CYGWIN32__ to list of macros
+	controlling how to pause.
+
+Sun Dec  1 21:25:27 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* configure: Regenerated using autoconf-2.12.
+
+Mon Nov 25 21:16:15 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* configure: Regenerated using autoconf-2.11.
+
+1996-11-19  Dave Love  <d.love@dl.ac.uk>
+
+	* libI77/backspace.c: Include sys/types.h for size_t.
+
+Wed Nov  6 14:17:27 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* f2c.h.in: Properly comment out the unsupported stuff so
+	we don't get build-time errors.
+
+	* libF77/Version.c, libI77/Version.c: Restore macro definition
+	of version information.
+
+	* libI77/Makefile.in (OBJ): Add ftell_.o to list of objects.
+
+	* libI77/uio.c (do_ud): Fix up casts in PAD_UDread case just
+	like they were fixed in the other case.
+
+Thu Oct 31 22:27:45 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* libI77/ftell_.c (fseek_): Map incoming whence argument to
+	system's actual SEEK_CUR, SEEK_SET, or SEEK_END macro for
+	fseek(), and crash (gracefully) if the argument is invalid.
+
+1996-10-19  Dave Love  <d.love@dl.ac.uk>
+
+	* configure.in: Add check that we have the tools to cross-compile
+ 	if appropriate.
+	(NO_EOF_CHAR_CHECK,Skip_f2c_Undefs): Define.
+
+	* libF77/Makefile.in (F90BIT): New routines from Netlib.
+
+	* f2c.h.in:
+	Use more sanitary #error (indented for K&R compliance if necessary) if
+	f2c_i2 defined.
+	Sync with Netlib: Add `uninteger'.  (Commented out) integer*8 stuff.
+	bit_{test,clear,set} macros.
+
+1996-10-19  Dave Love  <d.love@dl.ac.uk>
+
+	Update to Netlib version of 1996-09-26.
+	
+	* libI77/Version.c: Use <stdio.h>, not "stdio.h".
+	* libF77/Version.c: Likewise.
+
+Wed Aug 28 13:25:29 1996  Dave Love  <d.love@dl.ac.uk>
+
+	* libI77/rsne.c (x_rsne): Use size_t instead of int.
+
+	* libI77/endfile.c (copy): Use size_t in place of int.
+
+Wed Aug 28 13:22:20 1996  Dave Love  <d.love@dl.ac.uk>
+
+	* libI77/backspace.c (f_back): Cast fread arg to size_t.
+
+Tue Aug 27 19:11:30 1996  Dave Love  <d.love@dl.ac.uk>
+
+	* libI77/Version.c: Supply */ to avoid apparent nested comment.
+
+Tue Aug 20 09:21:43 1996  Dave Love  <d.love@dl.ac.uk>
+
+	* libF77/Makefile.in (ALL_CFLAGS): Fix missing ../ for include.
+	* libI77/Makefile.in (ALL_CFLAGS): Likewise.
+
+Sat Aug 17 13:00:47 1996  Dave Love  <d.love@dl.ac.uk>
+
+	* (libF77/qbitshft.c, libF77/qbitbits.c, libF77/lbitshft.c,
+ 	libF77/lbitbits.c): New file from Netlib.  qbit... not currently
+	compiled.
+
+Sun Jul  7 18:06:33 1996  Dave Love  <d.love@dl.ac.uk>
+
+	* libF77/z_sqrt.c, libF77/z_sin.c, libF77/z_exp.c, libF77/z_log.c,
+ 	libF77/system_.c, libF77/z_cos.c, libF77/signal_.c,
+ 	libF77/s_stop.c, libF77/sig_die.c, libF77/s_paus.c,
+ 	libF77/s_rnge.c, libF77/s_cat.c, libF77/r_tan.c, libF77/r_tanh.c,
+ 	libF77/r_sinh.c, libF77/r_sqrt.c, libF77/r_sin.c, libF77/r_mod.c,
+ 	libF77/r_nint.c, libF77/r_lg10.c, libF77/r_log.c, libF77/r_exp.c,
+ 	libF77/r_int.c, libF77/r_cosh.c, libF77/r_atn2.c, libF77/r_cos.c,
+ 	libF77/r_asin.c, libF77/r_atan.c, libF77/r_acos.c,
+ 	libF77/pow_dd.c, libF77/pow_zz.c, libF77/main.c, libF77/i_dnnt.c,
+ 	libF77/i_nint.c, libF77/h_dnnt.c, libF77/h_nint.c, libF77/exit.c,
+ 	libF77/d_tan.c, libF77/d_tanh.c, libF77/d_sqrt.c, libF77/d_sin.c,
+ 	libF77/d_sinh.c, libF77/d_mod.c, libF77/d_nint.c, libF77/d_log.c,
+ 	libF77/d_int.c, libF77/d_lg10.c, libF77/d_cosh.c, libF77/d_exp.c,
+ 	libF77/d_atn2.c, libF77/d_cos.c, libF77/d_atan.c, libF77/d_acos.c,
+ 	libF77/d_asin.c, libF77/c_sqrt.c, libF77/cabs.c, libF77/c_sin.c,
+ 	libF77/c_exp.c, libF77/c_log.c, libF77/c_cos.c, libF77/F77_aloc.c,
+ 	libF77/abort_.c, libI77/xwsne.c, libI77/wref.c, libI77/util.c,
+ 	libI77/uio.c, libI77/rsne.c, libI77/rdfmt.c, libI77/rawio.h,
+ 	libI77/open.c, libI77/lread.c, libI77/inquire.c, libI77/fio.h,
+ 	libI77/err.c, libI77/endfile.c, libI77/close.c:
+	Use #include <...>, not #include "..." for mkdeps
+
+Sat Jul  6 21:39:21 1996  Dave Love  <d.love@dl.ac.uk>
+
+	* libI77/ftell_.c: Added from Netlib distribution.
+
+Sat Mar 30 20:57:24 1996  Dave Love  <d.love@dl.ac.uk>
+
+	* configure.in: Eliminate explicit use of
+ 	{RANLIB,AR}_FOR_TARGET.
+	* Makefile.in: Likewise.
+	* libF77/Makefile.in: Likewise.
+	* libI77/Makefile.in: Likewise.
+	* configure: Regenerated.
+
+Sat Mar 30 21:02:03 1996  Dave Love  <d.love@dl.ac.uk>
+
+	* Makefile.in: Eliminate explicit use of
+ 	{RANLIB,AR}_FOR_TARGET.
+
+Tue Mar 26 23:39:59 1996  Dave Love  <d.love@dl.ac.uk>
+
+	* Makefile.in: Remove hardwired RANLIB and RANLIB_TEST (unnoted
+ 	change).
+
+Mon Mar 25 21:04:56 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* Incorporate changes by Bell Labs to libf2c through 1996-03-23,
+	including changes to dmg and netlib email addresses.
+
+Tue Mar 19 13:10:02 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* Incorporate changes by AT&T/Bellcore to libf2c through 1996-03-19.
+
+	* Makefile.in (rebuilt): New target.
+
+	* lib[FI]77/Makefile.in: Use $AR_FOR_TARGET, not $AR.
+
+Tue Mar 19 12:53:19 1996  Dave Love  <d.love@dl.ac.uk>
+
+	* configure.in (ac_cpp): #include <stdio.h> instead
+	of <features.h>.
+
+Tue Mar 19 12:52:09 1996  Mumit Khan  <khan@xraylith.wisc.edu>
+
+	* configure.in (ac_cpp): For f2c integer type,
+	add -I$srcdir/../.. to make it work on mips-ultrix4.2.
+
+Sat Mar  9 17:37:15 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* libI77/Makefile.in (.c.o): Add -DAllow_TYQUAD, to enable
+	I/O support for INTEGER*8.
+	* f2c.h.in: Turn on longint type.
+
+Fri Dec 29 18:22:01 1995  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* Makefile.in: Reorganize the *clean rules to more closely
+	parallel gcc's.
+
+	* lib[FI]77/Makefile.in: Ignore error from $(AR) command,
+	in case just doing an install and installer has no write
+	access to library (this is a kludge fix -- perhaps install
+	targets should never try updating anything?).
+
+Sat Nov 18 19:37:22 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Version 0.5.17 released.
+
+Thu Nov 16 07:20:35 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Incorporate changes by AT&T/Bellcore to libf2c through 1995-11-15.
+
+Fri Sep 22 02:19:59 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* libI77/backspace.c, libI77/close.c, libI77/endfile.c,
+	libI77/fio.h, libI77/inquire.c, libI77/rawio.h,
+	libF77/s_paus.c: Not an MSDOS system if GO32
+	is defined, in the sense that the run-time environment
+	is thus more UNIX-like.
+
+Wed Sep 20 02:24:51 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* libF77/Makefile.in, libI77/Makefile.in: Comment out `ld -r -x'
+	and `mv' line pairs, since `-x' isn't supported on systems
+	such as Solaris, and these lines don't seem to do anything
+	useful after all.
+
+Wed Aug 30 15:58:35 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Version 0.5.16 released.
+
+	* Incorporate changes by AT&T/Bellcore to libf2c through 950829.
+
+Mon Aug 28 12:50:34 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* libF77/Makefile.in, libI77/Makefile.in ($(lib)): Force ar'ing
+	and ranlib'ing of libf2c.a, else after rm'ing libf2c.a and
+	doing a make, only libI77 or libF77 would be added to
+	the newly created archive.
+	Also, instead of `$?' list all targets explicitly so all
+	objects are updated in libf2c.a even if only one actually
+	needs recompiling, for similar reason -- we can't easily tell
+	if a given object is really up-to-date in libf2c.a, or even
+	present there.
+
+Sun Aug 27 14:54:24 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* libF77/Makefile.in, libI77/Makefile.in: Fix spacing so
+	initial tabs are present in all appropriate places.
+	Move identical $(AR) commands in if then/else clauses
+	to single command preceding if.
+	(.c.o, Version[FI].o): Use $@ instead of $* because AIX (RS/6000)
+	says $@ means source, not object, basename, and $@ seems to work
+	everywhere.
+
+Wed Aug 23 15:44:25 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* libF77/system_.c (system_): Declare as returning `ftnint',
+	consistent with signal_, instead of defaulting to `int'.
+	Hope dmg@research.att.com agrees, else probably will
+	change to whatever he determines is correct (and change
+	g77 accordingly).
+
+Thu Aug 17 08:46:17 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* libI77/rsne.c (s_rsne): Call f_init if not already done.
+
+Thu Aug 17 04:35:28 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Incorporate changes by Bellcore to libf2c through 950817.
+	And this text is for EMACS: (foo at bar).
+
+Wed Aug 16 17:33:06 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* libF77/Makefile.in, libI77/Makefile.in (CFLAGS): Put -g1
+	after configured CFLAGS but before GCC_CFLAGS, so by default
+	the libraries are built with minimal debugging information.
+
+Fri Jul 28 10:30:15 1995  Dave Love  <d.love@dl.ac.uk>
+
+	* libI77/open.c (f_open): Call f_init if not already done.
+
+Sat Jul  1 19:31:56 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* libF77/system_.c (system_): Make buff one byte bigger so
+	following byte doesn't get overwritten by call with large
+	string.
+
+Tue Jun 27 23:28:16 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Incorporate changes by Bellcore to libf2c through 950613.
+
+	* libF77/Version.c (__G77_LIBF77_VERSION__): Add this string
+	to track g77 mods to libf2c.
+
+	* libI77/Version.c (__G77_LIBI77_VERSION__): Add this string
+	to track g77 mods to libf2c.
+
+	* libI77/rawio.h: #include <rawio.h> only conditionally,
+	using macro intended for that purpose.
+
+Fri May 19 11:20:00 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* configure.in: Incorporate change made by d.love,
+
+	* configure: Regenerated.
+
+Wed Apr 26 21:08:57 BST 1995  Dave Love  <d.love@dl.ac.uk>
+
+	* configure.in: Fix quoting problem in atexit check.
+
+	* configure: Regenerated (with current autoconf).
+
+Wed Mar 15 12:49:58 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Incorporate changes by Bellcore to libf2c through 950315.
+
+Sun Mar  5 18:54:29 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* README: Tell people not to read lib[fi]77/README.
+
+Wed Feb 15 14:30:58 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* configure.in: Update copyright notice at top of file.
+
+	* f2c.h.in (f2c_i2): Make sure defining this crashes compilations.
+
+	* libI77/Makefile.in (F2C_H): Fix typo in definition of this
+	symbol (was FF2C_H=...).
+
+Sun Feb 12 13:39:36 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* README: Remove some obsolete items.
+	Add date.
+
+	* TODO: Add date.
+
+Sat Feb 11 22:07:54 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Makefile.in (libf77, libi77): Add rules to .PHONY list.
+
+	* f2c.h.in (flag): Make same type as friends.
+
+	* libF77/Makefile.in (libf77): Rename to $(lib), remove from
+	.PHONY list.  Fix some typos.
+
+	* libI77/Makefile.in (libi77): Rename to $(lib), remove from
+	.PHONY list.  Fix some typos.
+
+Thu Feb  2 12:22:41 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Makefile.in (libF77/Makefile): Fix typos in this rule's name
+	and dependencies.
+
+	* libF77/Makefile.in (libf77): Add rule to .PHONY list.
+
+	* libI77/Makefile.in (libi77): Add rule to .PHONY list.
diff --git a/gcc/f/runtime/Makefile.in b/gcc/f/runtime/Makefile.in
new file mode 100644
index 00000000000..1a20476bd26
--- /dev/null
+++ b/gcc/f/runtime/Makefile.in
@@ -0,0 +1,251 @@
+# Makefile for GNU F77 compiler runtime.
+#   Copyright (C) 1995-1997 Free Software Foundation, Inc.
+#   Contributed by Dave Love (d.love@dl.ac.uk).
+#
+#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.
+
+#### Start of system configuration section. ####
+
+# $(srcdir) must be set to the g77 runtime source directory
+# (g77/f/runtime/).
+
+srcdir = @srcdir@
+VPATH = @srcdir@
+
+top_srcdir = @top_srcdir@
+
+INSTALL = @INSTALL@		# installs aren't actually done from here
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_DATA = @INSTALL_DATA@
+RANLIB = @RANLIB@
+RANLIB_TEST = @RANLIB_TEST@
+
+CFLAGS = @CFLAGS@
+CPPFLAGS = @CPPFLAGS@ @DEFS@
+LDFLAGS = @LDFLAGS@
+LIBS = @LIBS@
+CGFLAGS = -g0
+
+GCC_FOR_TARGET = @CC@
+CC = $(GCC_FOR_TARGET)
+
+CROSS = @CROSS@
+
+objext = .o
+
+transform=@program_transform_name@
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+
+AR = ar
+AR_FLAGS = rc
+
+# Directory in which to install scripts.
+bindir = $(exec_prefix)/bin
+
+# Directory in which to install library files.
+libdir = $(prefix)/lib
+
+# Directory in which to install documentation info files.
+infodir = $(prefix)/info
+
+#### End of system configuration section. ####
+
+SHELL = /bin/sh
+
+lib = ../../libf2c.a
+
+SUBDIRS = libI77 libF77 libU77
+
+MISC =	libF77/F77_aloc.o libF77/VersionF.o libF77/main.o libF77/s_rnge.o \
+	libF77/abort_.o libF77/getarg_.o libF77/iargc_.o libF77/getenv_.o \
+	libF77/signal_.o libF77/s_stop.o libF77/s_paus.o libF77/system_.o \
+	libF77/cabs.o libF77/derf_.o libF77/derfc_.o libF77/erf_.o \
+	libF77/erfc_.o libF77/sig_die.o libF77/exit_.o
+POW =	libF77/pow_ci.o libF77/pow_dd.o libF77/pow_di.o libF77/pow_hh.o \
+	libF77/pow_ii.o  libF77/pow_ri.o libF77/pow_zi.o libF77/pow_zz.o \
+	libF77/pow_qq.o
+CX =	libF77/c_abs.o libF77/c_cos.o libF77/c_div.o libF77/c_exp.o \
+	libF77/c_log.o libF77/c_sin.o libF77/c_sqrt.o
+DCX =	libF77/z_abs.o libF77/z_cos.o libF77/z_div.o libF77/z_exp.o \
+	libF77/z_log.o libF77/z_sin.o libF77/z_sqrt.o
+REAL =	libF77/r_abs.o libF77/r_acos.o libF77/r_asin.o libF77/r_atan.o \
+	libF77/r_atn2.o libF77/r_cnjg.o libF77/r_cos.o libF77/r_cosh.o \
+	libF77/r_dim.o libF77/r_exp.o libF77/r_imag.o libF77/r_int.o \
+	libF77/r_lg10.o libF77/r_log.o libF77/r_mod.o libF77/r_nint.o \
+	libF77/r_sign.o libF77/r_sin.o libF77/r_sinh.o libF77/r_sqrt.o \
+	libF77/r_tan.o libF77/r_tanh.o
+DBL =	libF77/d_abs.o libF77/d_acos.o libF77/d_asin.o libF77/d_atan.o \
+	libF77/d_atn2.o libF77/d_cnjg.o libF77/d_cos.o libF77/d_cosh.o \
+	libF77/d_dim.o libF77/d_exp.o libF77/d_imag.o libF77/d_int.o \
+	libF77/d_lg10.o libF77/d_log.o libF77/d_mod.o libF77/d_nint.o \
+	libF77/d_prod.o libF77/d_sign.o libF77/d_sin.o libF77/d_sinh.o \
+	libF77/d_sqrt.o libF77/d_tan.o libF77/d_tanh.o
+INT =	libF77/i_abs.o libF77/i_dim.o libF77/i_dnnt.o libF77/i_indx.o \
+	libF77/i_len.o libF77/i_mod.o libF77/i_nint.o libF77/i_sign.o
+HALF =	libF77/h_abs.o libF77/h_dim.o libF77/h_dnnt.o libF77/h_indx.o \
+	libF77/h_len.o libF77/h_mod.o  libF77/h_nint.o libF77/h_sign.o
+CMP =	libF77/l_ge.o libF77/l_gt.o libF77/l_le.o libF77/l_lt.o \
+	libF77/hl_ge.o libF77/hl_gt.o libF77/hl_le.o libF77/hl_lt.o
+EFL =	libF77/ef1asc_.o libF77/ef1cmc_.o
+CHAR =	libF77/s_cat.o libF77/s_cmp.o libF77/s_copy.o
+F90BIT = libF77/lbitbits.o libF77/lbitshft.o libF77/qbitbits.o \
+	libF77/qbitshft.o
+FOBJ = $(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) $(HALF) $(CMP) \
+ $(EFL) $(CHAR) $(F90BIT)
+
+IOBJ =	libI77/VersionI.o libI77/backspace.o libI77/close.o libI77/dfe.o \
+	libI77/dolio.o libI77/due.o libI77/endfile.o libI77/err.o \
+	libI77/fmt.o libI77/fmtlib.o libI77/iio.o libI77/ilnw.o \
+	libI77/inquire.o libI77/lread.o libI77/lwrite.o libI77/open.o \
+	libI77/rdfmt.o libI77/rewind.o libI77/rsfe.o libI77/rsli.o \
+	libI77/rsne.o libI77/sfe.o libI77/sue.o libI77/typesize.o \
+	libI77/uio.o libI77/util.o libI77/wref.o libI77/wrtfmt.o \
+	libI77/wsfe.o libI77/wsle.o libI77/wsne.o libI77/xwsne.o \
+	libI77/ftell_.o
+
+UOBJ =  libU77/VersionU.o libU77/gerror_.o libU77/perror_.o libU77/ierrno_.o \
+	libU77/itime_.o libU77/time_.o libU77/unlink_.o libU77/fnum_.o \
+	libU77/getpid_.o libU77/getuid_.o libU77/getgid_.o libU77/kill_.o \
+	libU77/rand_.o libU77/srand_.o libU77/irand_.o libU77/sleep_.o \
+	libU77/idate_.o libU77/ctime_.o libU77/etime_.o libU77/dtime_.o \
+	libU77/isatty_.o libU77/ltime_.o libU77/fstat_.o libU77/stat_.o \
+	libU77/lstat_.o libU77/access_.o libU77/link_.o libU77/getlog_.o \
+	libU77/ttynam_.o libU77/getcwd_.o libU77/vxttime_.o \
+	libU77/vxtidate_.o libU77/gmtime_.o libU77/fdate_.o libU77/secnds_.o \
+	libU77/bes.o libU77/dbes.o libU77/chdir_.o libU77/chmod_.o \
+	libU77/lnblnk_.o libU77/hostnm_.o libU77/rename_.o libU77/fgetc_.o \
+	libU77/fputc_.o libU77/umask_.o libU77/system_clock_.o libU77/date_.o \
+	libU77/second_.o libU77/flush1_.o libU77/alarm_.o
+
+F2CEXT = abort derf derfc ef1asc ef1cmc erf erfc exit getarg getenv iargc \
+	signal system flush ftell fseek access besj0 besj1 besjn besy0 besy1 \
+	besyn chdir chmod ctime date dbesj0 dbesj1 dbesjn dbesy0 dbesy1 dbesyn \
+	dtime etime fdate fgetc fget flush1 fnum fputc fput fstat gerror \
+	getcwd getgid getlog getpid getuid gmtime hostnm idate ierrno irand \
+	isatty itime kill link lnblnk lstat ltime mclock perror rand rename \
+	secnds second sleep srand stat symlnk sclock time ttynam umask unlink \
+	vxtidt vxttim alarm
+
+# flags_to_pass to recursive makes & configure (hence the quoting style)
+FLAGS_TO_PASS = \
+	CROSS="$(CROSS)" \
+	AR_FLAGS="$(AR_FLAGS)" \
+	AR="$(AR)" \
+	GCCFLAGS="$(GCCFLAGS)" \
+	GCC_FOR_TARGET="$(GCC_FOR_TARGET)" \
+	CC="$(GCC_FOR_TARGET)" \
+	LDFLAGS="$(LDFLAGS)" \
+	RANLIB="$(RANLIB)" \
+	RANLIB_TEST="$(RANLIB_TEST)" \
+	SHELL="$(SHELL)"
+
+CROSS_FLAGS_TO_PASS = \
+	CROSS="$(CROSS)" \
+	AR_FLAGS="$(AR_FLAGS)" \
+	AR="$(AR)" \
+	GCCFLAGS="$(GCCFLAGS)" \
+	GCC_FOR_TARGET="$(GCC_FOR_TARGET)" \
+	CC="$(GCC_FOR_TARGET)" \
+	LDFLAGS="$(LDFLAGS)" \
+	RANLIB="$(RANLIB)" \
+	RANLIB_TEST="$(RANLIB_TEST)" \
+	SHELL="$(SHELL)"
+
+all: ../../include/f2c.h libi77 libf77 libu77 $(lib)
+
+$(lib): stamp-lib ; @true
+stamp-lib: $(FOBJ) $(IOBJ) $(UOBJ)
+	rm -f stamp-lib
+	$(AR) $(AR_FLAGS) $(lib) $?
+	for name in $(F2CEXT); \
+	do \
+	  echo $${name}; \
+	  $(GCC_FOR_TARGET) -c -I. -I$(srcdir) -I../../include $(CPPFLAGS) $(CFLAGS) $(CGFLAGS) \
+	    -DL$${name} $(srcdir)/f2cext.c; \
+	  if [ $$? -eq 0 ] ; then true; else exit 1; fi; \
+	  mv f2cext$(objext) L$${name}$(objext); \
+	  $(AR) $(AR_FLAGS) $(lib) L$${name}$(objext); \
+	  rm -f L$${name}$(objext); \
+	done
+	if $(RANLIB_TEST); then $(RANLIB) $(lib); \
+	  else true; fi
+	touch stamp-lib
+
+libi77: libI77/Makefile
+	if test "$(CROSS)"; then \
+	  cd libI77;  $(MAKE) -f Makefile $(CROSS_FLAGS_TO_PASS) all ; \
+	else \
+	  cd libI77;  $(MAKE) -f Makefile $(FLAGS_TO_PASS) all ; \
+	fi
+
+libf77: libF77/Makefile
+	if test "$(CROSS)"; then \
+	  cd libF77;  $(MAKE) -f Makefile $(CROSS_FLAGS_TO_PASS) all ; \
+	else \
+	  cd libF77;  $(MAKE) -f Makefile $(FLAGS_TO_PASS) all ; \
+	fi
+
+libu77: libU77/Makefile
+	if test "$(CROSS)"; then \
+	  cd libU77;  $(MAKE) -f Makefile $(CROSS_FLAGS_TO_PASS) all ; \
+	else \
+	  cd libU77;  $(MAKE) -f Makefile $(FLAGS_TO_PASS) all ; \
+	fi
+
+${srcdir}/configure: ${srcdir}/configure.in
+	rm -f config.cache && cd ${srcdir} && autoconf && rm -f config.cache
+${srcdir}/libU77/configure: ${srcdir}/libU77/configure.in
+	rm -f libU77/config.cache && cd ${srcdir}/libU77 && autoconf && rm -f config.cache
+#../include/f2c.h libI77/Makefile libF77/Makefile libU77/Makefile Makefile: ${srcdir}/Makefile.in \
+#  config.status libU77/config.status
+#	$(FLAGS_TO_PASS) CONFIG_SITE=/dev/null $(SHELL) config.status
+#	cd libU77; $(FLAGS_TO_PASS) CONFIG_SITE=/dev/null $(SHELL) config.status
+
+# Extra dependencies for the targets above:
+libI77/Makefile: $(srcdir)/libI77/Makefile.in
+libF77/Makefile: $(srcdir)/libF77/Makefile.in
+libU77/Makefile: $(srcdir)/libU77/Makefile.in
+../../include/f2c.h: $(srcdir)/f2c.h.in
+
+#config.status: ${srcdir}/configure
+#	$(FLAGS_TO_PASS) CONFIG_SITE=/dev/null $(SHELL) config.status --recheck
+#libU77/config.status: ${srcdir}/libU77/configure
+#	cd libU77; $(FLAGS_TO_PASS) CONFIG_SITE=/dev/null $(SHELL) config.status --recheck
+
+mostlyclean:
+	for i in libI77 libF77 libU77; do cd $$i; $(MAKE) -f Makefile mostlyclean; cd ..;  done
+
+clean:
+	-rm -f config.log config.cache
+	for i in libI77 libF77 libU77; do cd $$i; $(MAKE) -f Makefile clean; cd ..;  done
+
+distclean: clean
+	-rm -f Makefile lib?77/Makefile config.status libU77/config.status ../../include/f2c.h
+
+maintainer-clean: distclean
+	-rm -f $(srcdir)/configure $(srcdir)/libU77/configure
+
+uninstall:
+	rm ../../include/f2c.h
+
+rebuilt: ${srcdir}/configure ${srcdir}/libU77/configure
+
+.PHONY: libf77 libi77 libu77 rebuilt mostlyclean clean distclean maintainer-clean \
+  uninstall all
diff --git a/gcc/f/runtime/README b/gcc/f/runtime/README
new file mode 100644
index 00000000000..9419af77189
--- /dev/null
+++ b/gcc/f/runtime/README
@@ -0,0 +1,46 @@
+970811
+
+This directory contains the f2c library packaged for use with g77 to configure
+and build automatically (in principle!) as part of the top-level configure and
+make steps.  This depends on the makefile and configure fragments in ../f.
+
+Some small changes have been made to the f2c distributions of lib[FI]77 which
+come from <ftp:bell-labs.com/netlib/f2c/> and are maintained (excellently) by
+David M. Gay <dmg@bell-labs.com>.  See the Notice files for copyright
+information.  I'll try to get the changes rolled into the f2c distribution.
+
+Files that come directly from netlib are either maintained in the
+gcc/f/runtime/ directory under their original names or, if they
+are not pertinent for g77's version of libf2c, under their original
+names with `.netlib' appended.  For example, gcc/f/runtime/permissions.netlib
+is a copy of f2c's top-level`permissions' file in the netlib distribution.
+In this case, it applies only to the relevant portions of the libF77/ and
+libI77/ directories; it does not apply to the libU77/ directory, which is
+distributed under different licensing arrangements.  Similarly,
+the `makefile.netlib' files in libF77/ and libI77/ are copies of
+the respective `makefile' files in the netlib distribution, but
+are not used when building g77's version of libf2c.
+
+The `README.netlib' files in libF77/ and libI77/ thus might be
+interesting, but should not be taken as guidelines for how to
+configure and build libf2c in g77's distribution.
+
+The packaging for auto-configuration was done by Dave Love <d.love@dl.ac.uk>.
+Minor changes have been made by James Craig Burley <burley@gnu.ai.mit.edu>,
+who probably broke things Dave had working.  :-)
+
+Among the user-visible changes (choices) g77 makes in its
+version of libf2c:
+
+-  f2c.h configured to default to padding unformatted direct reads
+   (#define Pad_UDread), because that's the behavior most users
+   expect.
+
+-  f2c.h configured to default to outputting leading zeros before
+   decimal points in formatted and list-directed output, to be compatible
+   with many other compilers (#define WANT_LEAD_0).  Either way is
+   standard-conforming, however, and you should try to avoid writing
+   code that assumes one format or another.
+
+-  dtime_() and etime_() are from Dave Love's libU77, not from
+   netlib's libF77.
diff --git a/gcc/f/runtime/TODO b/gcc/f/runtime/TODO
new file mode 100644
index 00000000000..a44d1ed7f23
--- /dev/null
+++ b/gcc/f/runtime/TODO
@@ -0,0 +1,17 @@
+970811
+
+TODO list for the g77 library
+
+* `Makefile.in's should be brought up to standard; I'm not sure they
+  have a complete set of targets at present.
+
+* Investigate building shared libraries on systems we know about
+  (probably in 0.5.22, using libtool-1.0 from the FSF, which looks
+  quite useful).
+
+* Test cases.
+
+* Allow the library to be stripped to save space.
+
+* An interface to IEEE maths functions from libc where this makes
+  sense.
diff --git a/gcc/f/runtime/changes.netlib b/gcc/f/runtime/changes.netlib
new file mode 100644
index 00000000000..0edfba3a854
--- /dev/null
+++ b/gcc/f/runtime/changes.netlib
@@ -0,0 +1,2836 @@
+31 Aug. 1989:
+   1. A(min(i,j)) now is translated correctly (where A is an array).
+   2. 7 and 8 character variable names are allowed (but elicit a
+      complaint under -ext).
+   3. LOGICAL*1 is treated as LOGICAL, with just one error message
+      per LOGICAL*1 statement (rather than one per variable declared
+      in that statement).  [Note that LOGICAL*1 is not in Fortran 77.]
+      Like f77, f2c now allows the format in a read or write statement
+      to be an integer array.
+
+5 Sept. 1989:
+   Fixed botch in argument passing of substrings of equivalenced
+variables.
+
+15 Sept. 1989:
+   Warn about incorrect code generated when a character-valued
+function is not declared external and is passed as a parameter
+(in violation of the Fortran 77 standard) before it is invoked.
+Example:
+
+	subroutine foo(a,b)
+	character*10 a,b
+	call goo(a,b)
+	b = a(3)
+	end
+
+18 Sept. 1989:
+   Complain about overlapping initializations.
+
+20 Sept. 1989:
+   Warn about names declared EXTERNAL but never referenced;
+include such names as externs in the generated C (even
+though most C compilers will discard them).
+
+24 Sept. 1989:
+   New option -w8 to suppress complaint when COMMON or EQUIVALENCE
+forces word alignment of a double.
+   Under -A (for ANSI C), ensure that floating constants (terminated
+by 'f') contain either a decimal point or an exponent field.
+   Repair bugs sometimes encountered with CHAR and ICHAR intrinsic
+functions.
+   Restore f77's optimizations for copying and comparing character
+strings of length 1.
+   Always assume floating-point valued routines in libF77 return
+doubles, even under -R.
+   Repair occasional omission of arguments in routines having multiple
+entry points.
+   Repair bugs in computing offsets of character strings involved
+in EQUIVALENCE.
+   Don't omit structure qualification when COMMON variables are used
+as FORMATs or internal files.
+
+2 Oct. 1989:
+   Warn about variables that appear only in data stmts; don't emit them.
+   Fix bugs in character DATA for noncharacter variables
+involved in EQUIVALENCE.
+   Treat noncharacter variables initialized (at least partly) with
+character data as though they were equivalenced -- put out a struct
+and #define the variables.  This eliminates the hideous and nonportable
+numeric values that were used to initialize such variables.
+   Treat IMPLICIT NONE as IMPLICIT UNDEFINED(A-Z) .
+   Quit when given invalid options.
+
+8 Oct. 1989:
+  Modified naming scheme for generated intermediate variables;
+more are recycled, fewer distinct ones used.
+  New option -W nn specifies nn characters/word for Hollerith
+data initializing non-character variables.
+  Bug fix: x(i:min(i+10,j)) used to elicit "Can't handle opcode 31 yet".
+  Integer expressions of the form (i+const1) - (i+const2), where
+i is a scalar integer variable, are now simplified to (const1-const2);
+this leads to simpler translation of some substring expressions.
+  Initialize uninitialized portions of character string arrays to 0
+rather than to blanks.
+
+9 Oct. 1989:
+  New option -c to insert comments showing original Fortran source.
+  New option -g to insert line numbers of original Fortran source.
+
+10 Oct. 1989:
+  ! recognized as in-line comment delimiter (a la Fortran 88).
+
+24 Oct. 1989:
+  New options to ease coping with systems that want the structs
+that result from COMMON blocks to be defined just once:
+  -E causes uninitialized COMMON blocks to be declared Extern;
+if Extern is undefined, f2c.h #defines it to be extern.
+  -ec causes a separate .c file to be emitted for each
+uninitialized COMMON block: COMMON /ABC/ yields abc_com.c;
+thus one can compile *_com.c into a library to ensure
+precisely one definition.
+  -e1c is similar to -ec, except that everything goes into
+one file, along with comments that give a sed script for
+splitting the file into the pieces that -ec would give.
+This is for use with netlib's "execute f2c" service (for which
+-ec is coerced into -e1c, and the sed script will put everything
+but the COMMON definitions into f2c_out.c ).
+
+28 Oct. 1989:
+  Convert "i = i op ..." into "i op= ...;" even when i is a
+dummy argument.
+
+13 Nov. 1989:
+  Name integer constants (passed as arguments) c__... rather
+than c_... so
+	common /c/stuff
+	call foo(1)
+	...
+is translated correctly.
+
+19 Nov. 1989:
+  Floating-point constants are now kept as strings unless they
+are involved in constant expressions that get simplified.  The
+floating-point constants kept as strings can have arbitrarily
+many significant figures and a very large exponent field (as
+large as long int allows on the machine on which f2c runs).
+Thus, for example, the body of
+
+	subroutine zot(x)
+	double precision x(6), pi
+	parameter (pi=3.1415926535897932384626433832795028841972)
+	x(1) = pi
+	x(2) = pi+1
+	x(3) = 9287349823749272.7429874923740978492734D-298374
+	x(4) = .89
+	x(5) = 4.0005
+	x(6) = 10D7
+	end
+
+now gets translated into
+
+    x[1] = 3.1415926535897932384626433832795028841972;
+    x[2] = 4.1415926535897931;
+    x[3] = 9.2873498237492727429874923740978492734e-298359;
+    x[4] = (float).89;
+    x[5] = (float)4.0005;
+    x[6] = 1e8;
+
+rather than the former
+
+    x[1] = 3.1415926535897931;
+    x[2] = 4.1415926535897931;
+    x[3] = 0.;
+    x[4] = (float)0.89000000000000003;
+    x[5] = (float)4.0004999999999997;
+    x[6] = 100000000.;
+
+  Recognition of f77 machine-constant intrinsics deleted, i.e.,
+epbase, epprec, epemin, epemax, eptiny, ephuge, epmrsp.
+
+22 Nov. 1989:
+  Workarounds for glitches on some Sun systems...
+  libf77: libF77/makefile modified to point out possible need
+to compile libF77/main.c with -Donexit=on_exit .
+  libi77: libI77/wref.c (and libI77/README) modified so non-ANSI
+systems can compile with USE_STRLEN defined, which will cause
+	sprintf(b = buf, "%#.*f", d, x);
+	n = strlen(b) + d1;
+rather than
+	n = sprintf(b = buf, "%#.*f", d, x) + d1;
+to be compiled.
+
+26 Nov. 1989:
+  Longer names are now accepted (up to 50 characters); names may
+contain underscores (in which case they will have two underscores
+appended, to avoid clashes with library names).
+
+28 Nov. 1989:
+  libi77 updated:
+	1. Allow 3 (or, on Crays, 4) digit exponents under format Ew.d .
+	2. Try to get things right on machines where ints have 16 bits.
+
+29 Nov. 1989:
+  Supplied missing semicolon in parameterless subroutines that
+have multiple entry points (all of them parameterless).
+
+30 Nov. 1989:
+  libf77 and libi77 revised to use types from f2c.h.
+  f2c now types floating-point valued C library routines as "double"
+rather than "doublereal" (for use with nonstandard C compilers for
+which "double" is IEEE double extended).
+
+1 Dec. 1989:
+  f2c.h updated to eliminate #defines rendered unnecessary (and,
+indeed, dangerous) by change of 26 Nov. to long names possibly
+containing underscores.
+  libi77 further revised: yesterday's change omitted two tweaks to fmt.h
+(tweaks which only matter if float and real or double and doublereal are
+different types).
+
+2 Dec. 1989:
+  Better error message (than "bad tag") for NAMELIST, which no longer
+inhibits C output.
+
+4 Dec. 1989:
+  Allow capital letters in hex constants (f77 extension; e.g.,
+x'a012BCd', X'A012BCD' and x'a012bcd' are all treated as the integer
+167848909).
+  libi77 further revised: lio.c lio.h lread.c wref.c wrtfmt.c tweaked
+again to allow float and real or double and doublereal to be different.
+
+6 Dec. 1989:
+  Revised f2c.h -- required for the following...
+  Simpler looking translations for abs, min, max, using #defines in
+revised f2c.h .
+  libi77: more corrections to types; additions for NAMELIST.
+  Corrected casts in some I/O calls.
+  Translation of NAMELIST; libi77 must still be revised.  Currently
+libi77 gives you a run-time error message if you attempt NAMELIST I/O.
+
+7 Dec. 1989:
+  Fixed bug that prevented local integer variables that appear in DATA
+stmts from being ASSIGNed statement labels.
+  Fillers (for DATA statements initializing EQUIVALENCEd variables and
+variables in COMMON) typed integer rather than doublereal (for slightly
+more portability, e.g. to Crays).
+  libi77: missing return values supplied in a few places; some tests
+reordered for better working on the Cray.
+  libf77: better accuracy for complex divide, complex square root,
+real mod function (casts to double; double temporaries).
+
+9 Dec. 1989:
+  Fixed bug that caused needless (albeit harmless) empty lines to be
+inserted in the C output when a comment line contained trailing blanks.
+  Further tweak to type of fillers: allow doublereal fillers if the
+struct has doublereal data.
+
+11 Dec. 1989:
+  Alteration of rule for producing external (C) names from names that
+contain underscores.  Now the external name is always obtained by
+appending a pair of underscores.
+
+12 Dec. 1989:
+  C production inhibited after most errors.
+
+15 Dec. 1989:
+  Fixed bug in headers for subroutines having two or more character
+strings arguments:  the length arguments were reversed.
+
+19 Dec. 1989:
+  f2c.h libf77 libi77: adjusted so #undefs in f2c.h should not foil
+compilation of libF77 and libI77.
+  libf77: getenv_ adjusted to work with unsorted environments.
+  libi77: the iostat= specifier should now work right with internal I/O.
+
+20 Dec. 1989:
+  f2c bugs fixed: In the absence of an err= specifier, the iostat=
+specifier was generally set wrong.  Character strings containing
+explicit nulls (\0) were truncated at the first null.
+  Unlabeled DO loops recognized; must be terminated by ENDDO.
+(Don't ask for CYCLE, EXIT, named DO loops, or DO WHILE.)
+
+29 Dec. 1989:
+  Nested unlabeled DO loops now handled properly; new warning for
+extraneous text at end of FORMAT.
+
+30 Dec. 1989:
+  Fixed bug in translating dble(real(...)), dble(sngl(...)), and
+dble(float(...)), where ... is either of type double complex or
+is an expression requiring assignment to intermediate variables (e.g.,
+dble(real(foo(x+1))), where foo is a function and x is a variable).
+Regard nonblank label fields on continuation lines as an error.
+
+3 Jan. 1990:
+  New option -C++ yields output that should be understood
+by C++ compilers.
+
+6 Jan. 1989:
+  -a now excludes variables that appear in a namelist from those
+that it makes automatic.  (As before, it also excludes variables
+that appear in a common, data, equivalence, or save statement.)
+  The syntactically correct Fortran
+	read(*,i) x
+	end
+now yields syntactically correct C (even though both the Fortran
+and C are buggy -- no FORMAT has not been ASSIGNed to i).
+
+7 Jan. 1990:
+  libi77: routines supporting NAMELIST added.  Surrounding quotes
+made optional when no ambiguity arises in a list or namelist READ
+of a character-string value.
+
+9 Jan. 1990:
+  f2c.src made available.
+
+16 Jan. 1990:
+  New options -P to produce ANSI C or C++ prototypes for procedures
+defined.  Change to -A and -C++: f2c tries to infer prototypes for
+invoked procedures unless the new -!P option is given.  New warning
+messages for inconsistent calling sequences among procedures within
+a single file.  Most of f2c/src is affected.
+  f2c.h: typedefs for procedure arguments added; netlib's f2c service
+will insert appropriate typedefs for use with older versions of f2c.h.
+
+17 Jan. 1990:
+  f2c/src: defs.h exec.c format.c proc.c putpcc.c version.c xsum0.out
+updated.  Castargs and protofile made extern in defs.h; exec.c
+modified so superfluous else clauses are diagnosed; unused variables
+omitted from declarations in format.c proc.c putpcc.c .
+
+21 Jan. 1990:
+  No C emitted for procedures declared external but not referenced.
+  f2c.h: more new types added for use with -P.
+  New feature: f2c accepts as arguments files ending in .p or .P;
+such files are assumed to be prototype files, such as produced by
+the -P option.  All prototype files are read before any Fortran files
+and apply globally to all Fortran files.  Suitable prototypes help f2c
+warn about calling-sequence errors and can tell f2c how to type
+procedures declared external but not explicitly typed; the latter is
+mainly of interest for users of the -A and -C++ options.  (Prototype
+arguments are not available to netlib's "execute f2c" service.)
+  New option -it tells f2c to try to infer types of untyped external
+arguments from their use as parameters to prototyped or previously
+defined procedures.
+  f2c/src: many minor cleanups; most modules changed.  Individual
+files in f2c/src are now in "bundle" format.  The former f2c.1 is
+now f2c.1t; "f2c.1t from f2c" and "f2c.1t from f2c/src" are now the
+same, as are "f2c.1 from f2c" and "f2c.1 from f2c/src".  People who
+do not obtain a new copy of "all from f2c/src" should at least add
+	fclose(sortfp);
+after the call on do_init_data(outfile, sortfp) in format_data.c .
+
+22 Jan. 1990:
+  Cleaner man page wording (thanks to Doug McIlroy).
+  -it now also applies to all untyped EXTERNAL procedures, not just
+arguments.
+
+23 Jan. 01:34:00 EST 1990:
+  Bug fixes: under -A and -C++, incorrect C was generated for
+subroutines having multiple entries but no arguments.
+  Under -A -P, subroutines of no arguments were given prototype
+calling sequence () rather than (void).
+  Character-valued functions elicited erroneous warning messages
+about inconsistent calling sequences when referenced by another
+procedure in the same file.
+  f2c.1t: omit first appearance of libF77.a in FILES section;
+load order of libraries is -lF77 -lI77, not vice versa (bug
+introduced in yesterday's edits); define .F macro for those whose
+-man lacks it.  (For a while after yesterday's fixes were posted,
+f2c.1t was out of date.  Sorry!)
+
+23 Jan. 9:53:24 EST 1990:
+  Character substring expressions involving function calls having
+character arguments (including the intrinsic len function) yielded
+incorrect C.
+  Procedures defined after invocation (in the same file) with
+conflicting argument types also got an erroneous message about
+the wrong number of arguments.
+
+24 Jan. 11:44:00 EST 1990:
+  Bug fixes: -p omitted #undefs; COMMON block names containing
+underscores had their C names incorrectly computed; a COMMON block
+having the name of a previously defined procedure wreaked havoc;
+if all arguments were .P files, f2c tried reading the second as a
+Fortran file.
+  New feature: -P emits comments showing COMMON block lengths, so one
+can get warnings of incompatible COMMON block lengths by having f2c
+read .P (or .p) files.  Now by running f2c twice, first with -P -!c
+(or -P!c),  then with *.P among the arguments, you can be warned of
+inconsistent COMMON usage, and COMMON blocks having inconsistent
+lengths will be given the maximum length.  (The latter always did
+happen within each input file; now -P lets you extend this behavior
+across files.)
+
+26 Jan. 16:44:00 EST 1990:
+  Option -it made less aggressive: untyped external procedures that
+are invoked are now typed by the rules of Fortran, rather than by
+previous use of procedures to which they are passed as arguments
+before being invoked.
+  Option -P now includes information about references, i.e., called
+procedures, in the prototype files (in the form of special comments).
+This allows iterative invocations of f2c to infer more about untyped
+external names, particularly when multiple Fortran files are involved.
+  As usual, there are some obscure bug fixes:
+1.  Repair of erroneous warning messages about inconsistent number of
+arguments that arose when a character dummy parameter was discovered
+to be a function or when multiple entry points involved character
+variables appearing in a previous entry point.
+2.  Repair of memory fault after error msg about "adjustable character
+function".
+3.  Under -U, allow MAIN_ as a subroutine name (in the same file as a
+main program).
+4.  Change for consistency: a known function invoked as a subroutine,
+then as a function elicits a warning rather than an error.
+
+26 Jan. 22:32:00 EST 1990:
+  Fixed two bugs that resulted in incorrect C for substrings, within
+the body of a character-valued function, of the function's name, when
+those substrings were arguments to another function (even implicitly,
+as in character-string assignment).
+
+28 Jan. 18:32:00 EST 1990:
+  libf77, libi77: checksum files added; "make check" looks for
+transmission errors.  NAMELIST read modified to allow $ rather than &
+to precede a namelist name, to allow $ rather than / to terminate
+input where the name of another variable would otherwise be expected,
+and to regard all nonprinting ASCII characters <= ' ' as spaces.
+
+29 Jan. 02:11:00 EST 1990:
+  "fc from f2c" added.
+  -it option made the default; -!it turns it off.  Type information is
+now updated in a previously missed case.
+  -P option tweaked again; message about when rerunning f2c may change
+prototypes or declarations made more accurate.
+  New option -Ps implies -P and returns exit status 4 if rerunning
+f2c -P with prototype inputs might change prototypes or declarations.
+Now you can execute a crude script like
+
+	cat *.f >zap.F
+	rm -f zap.P
+	while :; do
+		f2c -Ps -!c zap.[FP]
+		case $? in 4) ;; *) break;; esac
+		done
+
+to get a file zap.P of the best prototypes f2c can determine for *.f .
+
+Jan. 29 07:30:21 EST 1990:
+  Forgot to check for error status when setting return code 4 under -Ps;
+error status (1, 2, 3, or, for caught signal, 126) now takes precedence.
+
+Jan 29 14:17:00 EST 1990:
+  Incorrect handling of
+	open(n,'filename')
+repaired -- now treated as
+	open(n,file='filename')
+(and, under -ext, given an error message).
+  New optional source file memset.c for people whose systems don't
+provide memset, memcmp, and memcpy; #include <string.h> in mem.c
+changed to #include "string.h" so BSD people can create a local
+string.h that simply says #include <strings.h> .
+
+Jan 30 10:34:00 EST 1990:
+  Fix erroneous warning at end of definition of a procedure with
+character arguments when the procedure had previously been called with
+a numeric argument instead of a character argument.  (There were two
+warnings, the second one incorrectly complaining of a wrong number of
+arguments.)
+
+Jan 30 16:29:41 EST 1990:
+  Fix case where -P and -Ps erroneously reported another iteration
+necessary.  (Only harm is the extra iteration.)
+
+Feb 3 01:40:00 EST 1990:
+  Supply semicolon occasionally omitted under -c .
+  Try to force correct alignment when numeric variables are initialized
+with character data (a non-standard and non-portable practice).  You
+must use the -W option if your code has such data statements and is
+meant to run on a machine with other than 4 characters/word; e.g., for
+code meant to run on a Cray, you would specify -W8 .
+  Allow parentheses around expressions in output lists (in write and
+print statements).
+  Rename source files so their names are <= 12 characters long
+(so there's room to append .Z and still have <= 14 characters);
+renamed files:  formatdata.c niceprintf.c niceprintf.h safstrncpy.c .
+  f2c material made available by anonymous ftp from research.att.com
+(look in dist/f2c ).
+
+Feb 3 03:49:00 EST 1990:
+  Repair memory fault that arose from use (in an assignment or
+call) of a non-argument variable declared CHARACTER*(*).
+
+Feb 9 01:35:43 EST 1990:
+  Fix erroneous error msg about bad types in
+	subroutine foo(a,adim)
+	dimension a(adim)
+	integer adim
+  Fix improper passing of character args (and possible memory fault)
+in the expression part of a computed goto.
+  Fix botched calling sequences in array references involving
+functions having character args.
+  Fix memory fault caused by invocation of character-valued functions
+of no arguments.
+  Fix botched calling sequence of a character*1-valued function
+assigned to a character*1 variable.
+  Fix bug in error msg for inconsistent number of args in prototypes.
+  Allow generation of C output despite inconsistencies in prototypes,
+but give exit code 8.
+  Simplify include logic (by removing some bogus logic); never
+prepend "/usr/include/" to file names.
+  Minor cleanups (that should produce no visible change in f2c's
+behavior) in intr.c parse.h main.c defs.h formatdata.c p1output.c .
+
+Feb 10 00:19:38 EST 1990:
+  Insert (integer) casts when floating-point expressions are used
+as subscripts.
+  Make SAVE stmt (with no variable list) override -a .
+  Minor cleanups: change field to Field in struct Addrblock (for the
+benefit of buggy C compilers); omit system("/bin/cp ...") in misc.c .
+
+Feb 13 00:39:00 EST 1990:
+  Error msg fix in gram.dcl: change "cannot make %s parameter"
+to "cannot make into parameter".
+
+Feb 14 14:02:00 EST 1990:
+  Various cleanups (invisible on systems with 4-byte ints), thanks
+to Dave Regan: vaxx.c eliminated; %d changed to %ld various places;
+external names adjusted for the benefit of stupid systems (that ignore
+case and recognize only 6 significant characters in external names);
+buffer shortened in xsum.c (e.g. for MS-DOS); fopen modes distinguish
+text and binary files; several unused functions eliminated; missing
+arg supplied to an unlikely fatalstr invocation.
+
+Thu Feb 15 19:15:53 EST 1990:
+  More cleanups (invisible on systems with 4 byte ints); casts inserted
+so most complaints from cyntax(1) and lint(1) go away; a few (int)
+versus (long) casts corrected.
+
+Fri Feb 16 19:55:00 EST 1990:
+  Recognize and translate unnamed Fortran 8x do while statements.
+  Fix bug that occasionally caused improper breaking of character
+strings.
+  New error message for attempts to provide DATA in a type-declaration
+statement.
+
+Sat Feb 17 11:43:00 EST 1990:
+  Fix infinite loop clf -> Fatal -> done -> clf after I/O error.
+  Change "if (addrp->vclass = CLPROC)" to "if (addrp->vclass == CLPROC)"
+in p1_addr (in p1output.c); this was probably harmless.
+  Move a misplaced } in lex.c (which slowed initkey()).
+  Thanks to Gary Word for pointing these things out.
+
+Sun Feb 18 18:07:00 EST 1990:
+  Detect overlapping initializations of arrays and scalar variables
+in previously missed cases.
+  Treat logical*2 as logical (after issuing a warning).
+  Don't pass string literals to p1_comment().
+  Correct a cast (introduced 16 Feb.) in gram.expr; this matters e.g.
+on a Cray.
+  Attempt to isolate UNIX-specific things in sysdep.c (a new source
+file).  Unless sysdep.c is compiled with SYSTEM_SORT defined, the
+intermediate files created for DATA statements are now sorted in-core
+without invoking system().
+
+Tue Feb 20 16:10:35 EST 1990:
+  Move definition of binread and binwrite from init.c to sysdep.c .
+  Recognize Fortran 8x tokens < <= == >= > <> as synonyms for
+.LT. .LE. .EQ. .GE. .GT. .NE.
+  Minor cleanup in putpcc.c:  fully remove simoffset().
+  More discussion of system dependencies added to libI77/README.
+
+Tue Feb 20 21:44:07 EST 1990:
+  Minor cleanups for the benefit of EBCDIC machines -- try to remove
+the assumption that 'a' through 'z' are contiguous.  (Thanks again to
+Gary Word.)  Also, change log2 to log_2 (shouldn't be necessary).
+
+Wed Feb 21 06:24:56 EST 1990:
+  Fix botch in init.c introduced in previous change; only matters
+to non-ASCII machines.
+
+Thu Feb 22 17:29:12 EST 1990:
+  Allow several entry points to mention the same array.  Protect
+parameter adjustments with if's (for the case that an array is not
+an argument to all entrypoints).
+  Under -u, allow
+	subroutine foo(x,n)
+	real x(n)
+	integer n
+  Compute intermediate variables used to evaluate dimension expressions
+at the right time.  Example previously mistranslated:
+	subroutine foo(x,k,m,n)
+	real x(min(k,m,n))
+	...
+	write(*,*) x
+  Detect duplicate arguments.  (The error msg points to the first
+executable stmt -- not wonderful, but not worth fixing.)
+  Minor cleanup of min/max computation (sometimes slightly simpler).
+
+Sun Feb 25 09:39:01 EST 1990:
+  Minor tweak to multiple entry points: protect parameter adjustments
+with if's only for (array) args that do not appear in all entry points.
+  Minor tweaks to format.c and io.c (invisible unless your compiler
+complained at the duplicate #defines of IOSUNIT and IOSFMT or at
+comparisons of p1gets(...) with NULL).
+
+Sun Feb 25 18:40:10 EST 1990:
+  Fix bug introduced Feb. 22: if a subprogram contained DATA and the
+first executable statement was labeled, then the label got lost.
+(Just change INEXEC to INDATA in p1output.c; it occurs just once.)
+
+Mon Feb 26 17:45:10 EST 1990:
+  Fix bug in handling of " and ' in comments.
+
+Wed Mar 28 01:43:06 EST 1990:
+libI77:
+ 1. Repair nasty I/O bug: opening two files and closing the first
+(after possibly reading or writing it), then writing the second caused
+the last buffer of the second to be lost.
+ 2. Formatted reads of logical values treated all letters other than
+t or T as f (false).
+ libI77 files changed: err.c rdfmt.c Version.c
+ (Request "libi77 from f2c" -- you can't get these files individually.)
+
+f2c itself:
+  Repair nasty bug in translation of
+	ELSE IF (condition involving complicated abs, min, or max)
+-- auxiliary statements were emitted at the wrong place.
+  Supply semicolon previously omitted from the translation of a label
+(of a CONTINUE) immediately preceding an ELSE IF or an ELSE.  This
+bug made f2c produce invalid C.
+  Correct a memory fault that occurred (on some machines) when the
+error message "adjustable dimension on non-argument" should be given.
+  Minor tweaks to remove some harmless warnings by overly chatty C
+compilers.
+  Argument arays having constant dimensions but a variable lower bound
+(e.g., x(n+1:n+3)) had a * omitted from scalar arguments involved in
+the array offset computation.
+
+Wed Mar 28 18:47:59 EST 1990:
+libf77: add exit(0) to end of main [return(0) encounters a Cray bug]
+
+Sun Apr  1 16:20:58 EDT 1990:
+  Avoid dereferencing null when processing equivalences after an error.
+
+Fri Apr  6 08:29:49 EDT 1990:
+  Calls involving alternate return specifiers omitted processing
+needed for things like min, max, abs, and // (concatenation).
+  INTEGER*2 PARAMETERs were treated as INTEGER*4.
+  Convert some O(n^2) parsing to O(n).
+
+Tue Apr 10 20:07:02 EDT 1990:
+  When inconsistent calling sequences involve differing numbers of
+arguments, report the first differing argument rather than the numbers
+of arguments.
+  Fix bug under -a: formatted I/O in which either the unit or the
+format was a local character variable sometimes resulted in invalid C
+(a static struct initialized with an automatic component).
+  Improve error message for invalid flag after elided -.
+  Complain when literal table overflows, rather than infinitely
+looping.  (The complaint mentions the new and otherwise undocumented
+-NL option for specifying a larger literal table.)
+  New option -h for forcing strings to word (or, with -hd, double-word)
+boundaries where possible.
+  Repair a bug that could cause improper splitting of strings.
+  Fix bug (cast of c to doublereal) in
+	subroutine foo(c,r)
+	double complex c
+	double precision r
+	c = cmplx(r,real(c))
+	end
+  New include file "sysdep.h" has some things from defs.h (and
+elsewhere) that one may need to modify on some systems.
+  Some large arrays that were previously statically allocated are now
+dynamically allocated when f2c starts running.
+  f2c/src files changed:
+	README cds.c defs.h f2c.1 f2c.1t format.c formatdata.c init.c
+	io.c lex.c main.c makefile mem.c misc.c names.c niceprintf.c
+	output.c parse_args.c pread.c put.c putpcc.c sysdep.h
+	version.c xsum0.out
+
+Wed Apr 11 18:27:12 EDT 1990:
+  Fix bug in argument consistency checking of character, complex, and
+double complex valued functions.  If the same source file contained a
+definition of such a function with arguments not explicitly typed,
+then subsequent references to the function might get erroneous
+warnings of inconsistent calling sequences.
+  Tweaks to sysdep.h for partially ANSI systems.
+  New options -kr and -krd cause f2c to use temporary variables to
+enforce Fortran evaluation-order rules with pernicious, old-style C
+compilers that apply the associative law to floating-point operations.
+
+Sat Apr 14 15:50:15 EDT 1990:
+  libi77: libI77 adjusted to allow list-directed and namelist I/O
+of internal files; bug in namelist I/O of logical and character arrays
+fixed; list input of complex numbers adjusted to permit d or D to
+denote the start of the exponent field of a component.
+  f2c itself: fix bug in handling complicated lower-bound
+expressions for character substrings; e.g., min and max did not work
+right, nor did function invocations involving character arguments.
+  Switch to octal notation, rather than hexadecimal, for nonprinting
+characters in character and string constants.
+  Fix bug (when neither -A nor -C++ was specified) in typing of
+external arguments of type complex, double complex, or character:
+	subroutine foo(c)
+	external c
+	complex c
+now results in
+	/* Complex */ int (*c) ();
+(as, indeed, it once did) rather than
+	complex (*c) ();
+
+Sat Apr 14 22:50:39 EDT 1990:
+  libI77/makefile: updated "make check" to omit lio.c
+  lib[FI]77/makefile: trivial change: define CC = cc, reference $(CC).
+  (Request, e.g., "libi77 from f2c" -- you can't ask for individual
+files from lib[FI]77.)
+
+Wed Apr 18 00:56:37 EDT 1990:
+  Move declaration of atof() from defs.h to sysdep.h, where it is
+now not declared if stdlib.h is included.  (NeXT's stdlib.h has a
+#define atof that otherwise wreaks havoc.)
+  Under -u, provide a more intelligible error message (than "bad tag")
+for an attempt to define a function without specifying its type.
+
+Wed Apr 18 17:26:27 EDT 1990:
+  Recognize \v (vertical tab) in Hollerith as well as quoted strings;
+add recognition of \r (carriage return).
+  New option -!bs turns off recognition of escapes in character strings
+(\0, \\, \b, \f, \n, \r, \t, \v).
+  Move to sysdep.c initialization of some arrays whose initialization
+assumed ASCII; #define Table_size in sysdep.h rather than using
+hard-coded 256 in allocating arrays of size 1 << (bits/byte).
+
+Thu Apr 19 08:13:21 EDT 1990:
+  Warn when escapes would make Hollerith extend beyond statement end.
+  Omit max() definition from misc.c (should be invisible except on
+systems that erroneously #define max in stdlib.h).
+
+Mon Apr 23 22:24:51 EDT 1990:
+  When producing default-style C (no -A or -C++), cast switch
+expressions to (int).
+  Move "-lF77 -lI77 -lm -lc" to link_msg, defined in sysdep.c .
+  Add #define scrub(x) to sysdep.h, with invocations in format.c and
+formatdata.c, so that people who have systems like VMS that would
+otherwise create multiple versions of intermediate files can
+#define scrub(x) unlink(x)
+
+Tue Apr 24 18:28:36 EDT 1990:
+  Pass string lengths once rather than twice to a function of character
+arguments involved in comparison of character strings of length 1.
+
+Fri Apr 27 13:11:52 EDT 1990:
+  Fix bug that made f2c gag on concatenations involving char(...) on
+some systems.
+
+Sat Apr 28 23:20:16 EDT 1990:
+  Fix control-stack bug in
+	if(...) then
+	else if (complicated condition)
+	else
+	endif
+(where the complicated condition causes assignment to an auxiliary
+variable, e.g., max(a*b,c)).
+
+Mon Apr 30 13:30:10 EDT 1990:
+  Change fillers for DATA with holes from substructures to arrays
+(in an attempt to make things work right with C compilers that have
+funny padding rules for substructures, e.g., Sun C compilers).
+  Minor cleanup of exec.c (should not affect generated C).
+
+Mon Apr 30 23:13:51 EDT 1990:
+  Fix bug in handling return values of functions having multiple
+entry points of differing return types.
+
+Sat May  5 01:45:18 EDT 1990:
+  Fix type inference bug in
+	subroutine foo(x)
+	call goo(x)
+	end
+	subroutine goo(i)
+	i = 3
+	end
+Instead of warning of inconsistent calling sequences for goo,
+f2c was simply making i a real variable; now i is correctly
+typed as an integer variable, and f2c issues an error message.
+  Adjust error messages issued at end of declarations so they
+don't blame the first executable statement.
+
+Sun May  6 01:29:07 EDT 1990:
+  Fix bug in -P and -Ps: warn when the definition of a subprogram adds
+information that would change prototypes or previous declarations.
+
+Thu May 10 18:09:15 EDT 1990:
+  Fix further obscure bug with (default) -it: inconsistent calling
+sequences and I/O statements could interact to cause a memory fault.
+Example:
+      SUBROUTINE FOO
+      CALL GOO(' Something') ! Forgot integer first arg
+      END
+      SUBROUTINE GOO(IUNIT,MSG)
+      CHARACTER*(*)MSG
+      WRITE(IUNIT,'(1X,A)') MSG
+      END
+
+Fri May 11 16:49:11 EDT 1990:
+  Under -!c, do not delete any .c files (when there are errors).
+  Avoid dereferencing 0 when a fatal error occurs while reading
+Fortran on stdin.
+
+Wed May 16 18:24:42 EDT 1990:
+  f2c.ps made available.
+
+Mon Jun  4 12:53:08 EDT 1990:
+  Diagnose I/O units of invalid type.
+  Add specific error msg about dummy arguments in common.
+
+Wed Jun 13 12:43:17 EDT 1990:
+  Under -A, supply a missing "[1]" for CHARACTER*1 variables that appear
+both in a DATA statement and in either COMMON or EQUIVALENCE.
+
+Mon Jun 18 16:58:31 EDT 1990:
+  Trivial updates to f2c.ps .  ("Fortran 8x" --> "Fortran 90"; omit
+"(draft)" from "(draft) ANSI C".)
+
+Tue Jun 19 07:36:32 EDT 1990:
+  Fix incorrect code generated for ELSE IF(expression involving
+function call passing non-constant substring).
+  Under -h, preserve the property that strings are null-terminated
+where possible.
+  Remove spaces between # and define in lex.c output.c parse.h .
+
+Mon Jun 25 07:22:59 EDT 1990:
+  Minor tweak to makefile to reduce unnecessary recompilations.
+
+Tue Jun 26 11:49:53 EDT 1990:
+  Fix unintended truncation of some integer constants on machines
+where casting a long to (int) may change the value.  E.g., when f2c
+ran on machines with 16-bit ints, "i = 99999" was being translated
+to "i = -31073;".
+
+Wed Jun 27 11:05:32 EDT 1990:
+  Arrange for CHARACTER-valued PARAMETERs to honor their length
+specifications.  Allow CHAR(nn) in expressions defining such PARAMETERs.
+
+Fri Jul 20 09:17:30 EDT 1990:
+  Avoid dereferencing 0 when a FORMAT statement has no label.
+
+Thu Jul 26 11:09:39 EDT 1990:
+  Remarks about VOID and binread,binwrite added to README.
+  Tweaks to parse_args: should be invisible unless your compiler
+complained at (short)*store.
+
+Thu Aug  2 02:07:58 EDT 1990:
+  f2c.ps: change the first line of page 5 from
+	include stuff
+to
+	include 'stuff'
+
+Tue Aug 14 13:21:24 EDT 1990:
+  libi77: libI77 adjusted to treat tabs as spaces in list input.
+
+Fri Aug 17 07:24:53 EDT 1990:
+  libi77: libI77 adjusted so a blank='ZERO' clause (upper case Z)
+in an open of a currently open file works right.
+
+Tue Aug 28 01:56:44 EDT 1990:
+  Fix bug in warnings of inconsistent calling sequences: if an
+argument to a subprogram was never referenced, then a previous
+invocation of the subprogram (in the same source file) that
+passed something of the wrong type for that argument did not
+elicit a warning message.
+
+Thu Aug 30 09:46:12 EDT 1990:
+  libi77: prevent embedded blanks in list output of complex values;
+omit exponent field in list output of values of magnitude between
+10 and 1e8; prevent writing stdin and reading stdout or stderr;
+don't close stdin, stdout, or stderr when reopening units 5, 6, 0.
+
+Tue Sep  4 12:30:57 EDT 1990:
+  Fix bug in C emitted under -I2 or -i2 for INTEGER*4 FUNCTION.
+  Warn of missing final END even if there are previous errors.
+
+Fri Sep  7 13:55:34 EDT 1990:
+  Remark about "make xsum.out" and "make f2c" added to README.
+
+Tue Sep 18 23:50:01 EDT 1990:
+  Fix null dereference (and, on some systems, writing of bogus *_com.c
+files) under -ec or -e1c when a prototype file (*.p or *.P) describes
+COMMON blocks that do not appear in the Fortran source.
+  libi77:
+    Add some #ifdef lines (#ifdef MSDOS, #ifndef MSDOS) to avoid
+references to stat and fstat on non-UNIX systems.
+    On UNIX systems, add component udev to unit; decide that old
+and new files are the same iff both the uinode and udev components
+of unit agree.
+    When an open stmt specifies STATUS='OLD', use stat rather than
+access (on UNIX systems) to check the existence of the file (in case
+directories leading to the file have funny permissions and this is
+a setuid or setgid program).
+
+Thu Sep 27 16:04:09 EDT 1990:
+  Supply missing entry for Impldoblock in blksize array of cpexpr
+(in expr.c).  No examples are known where this omission caused trouble.
+
+Tue Oct  2 22:58:09 EDT 1990:
+  libf77: test signal(...) == SIG_IGN rather than & 01 in main().
+  libi77: adjust rewind.c so two successive rewinds after a write
+don't clobber the file.
+
+Thu Oct 11 18:00:14 EDT 1990:
+  libi77: minor cleanups: add #include "fcntl.h" to endfile.c, err.c,
+open.c; adjust g_char in util.c for segmented memories; in f_inqu
+(inquire.c), define x appropriately when MSDOS is defined.
+
+Mon Oct 15 20:02:11 EDT 1990:
+  Add #ifdef MSDOS pointer adjustments to mem.c; treat NAME= as a
+synonym for FILE= in OPEN statements.
+
+Wed Oct 17 16:40:37 EDT 1990:
+  libf77, libi77: minor cleanups: _cleanup() and abort() invocations
+replaced by invocations of sig_die in main.c; some error messages
+previously lost in buffers will now appear.
+
+Mon Oct 22 16:11:27 EDT 1990:
+  libf77: separate sig_die from main (for folks who don't want to use
+the main in libF77).
+  libi77: minor tweak to comments in README.
+
+Fri Nov  2 13:49:35 EST 1990:
+  Use two underscores rather than one in generated temporary variable
+names to avoid conflict with COMMON names.  f2c.ps updated to reflect
+this change and the NAME= extension introduced 15 Oct.
+  Repair a rare memory fault in io.c .
+
+Mon Nov  5 16:43:55 EST 1990:
+  libi77: changes to open.c (and err.c): complain if an open stmt
+specifies new= and the file already exists (as specified by Fortrans 77
+and 90); allow file= to be omitted in open stmts and allow
+status='replace' (Fortran 90 extensions).
+
+Fri Nov 30 10:10:14 EST 1990:
+  Adjust malloc.c for unusual systems whose sbrk() can return values
+not properly aligned for doubles.
+  Arrange for slightly more helpful and less repetitive warnings for
+non-character variables initialized with character data; these warnings
+are (still) suppressed by -w66.
+
+Fri Nov 30 15:57:59 EST 1990:
+  Minor tweak to README (about changing VOID in f2c.h).
+
+Mon Dec  3 07:36:20 EST 1990:
+  Fix spelling of "character" in f2c.1t.
+
+Tue Dec  4 09:48:56 EST 1990:
+  Remark about link_msg and libf2c added to f2c/README.
+
+Thu Dec  6 08:33:24 EST 1990:
+  Under -U, render label nnn as L_nnn rather than Lnnn.
+
+Fri Dec  7 18:05:00 EST 1990:
+  Add more names from f2c.h (e.g. integer, real) to the c_keywords
+list of names to which an underscore is appended to avoid confusion.
+
+Mon Dec 10 19:11:15 EST 1990:
+  Minor tweaks to makefile (./xsum) and README (binread/binwrite).
+  libi77: a few modifications for POSIX systems; meant to be invisible
+elsewhere.
+
+Sun Dec 16 23:03:16 EST 1990:
+  Fix null dereference caused by unusual erroneous input, e.g.
+	call foo('abc')
+	end
+	subroutine foo(msg)
+	data n/3/
+	character*(*) msg
+	end
+(Subroutine foo is illegal because the character statement comes after a
+data statement.)
+  Use decimal rather than hex constants in xsum.c (to prevent
+erroneous warning messages about constant overflow).
+
+Mon Dec 17 12:26:40 EST 1990:
+  Fix rare extra underscore in character length parameters passed
+for multiple entry points.
+
+Wed Dec 19 17:19:26 EST 1990:
+  Allow generation of C despite error messages about bad alignment
+forced by equivalence.
+  Allow variable-length concatenations in I/O statements, such as
+	open(3, file=bletch(1:n) // '.xyz')
+
+Fri Dec 28 17:08:30 EST 1990:
+  Fix bug under -p with formats and internal I/O "units" in COMMON,
+as in
+      COMMON /FIGLEA/F
+      CHARACTER*20 F
+      F = '(A)'
+      WRITE (*,FMT=F) 'Hello, world!'
+      END
+
+Tue Jan 15 12:00:24 EST 1991:
+  Fix bug when two equivalence groups are merged, the second with
+nonzero offset, and the result is then merged into a common block.
+Example:
+      INTEGER W(3), X(3), Y(3), Z(3)
+      COMMON /ZOT/ Z
+      EQUIVALENCE (W(1),X(1)), (X(2),Y(1)), (Z(3),X(1))
+***** W WAS GIVEN THE WRONG OFFSET
+  Recognize Fortran 90's optional NML= in NAMELIST READs and WRITEs.
+(Currently NML= and FMT= are treated as synonyms -- there's no
+error message if, e.g., NML= specifies a format.)
+  libi77: minor adjustment to allow internal READs from character
+string constants in read-only memory.
+
+Fri Jan 18 22:56:15 EST 1991:
+  Add comment to README about needing to comment out the typedef of
+size_t in sysdep.h on some systems, e.g. Sun 4.1.
+  Fix misspelling of "statement" in an error message in lex.c
+
+Wed Jan 23 00:38:48 EST 1991:
+  Allow hex, octal, and binary constants to have the qualifying letter
+(z, x, o, or b) either before or after the quoted string containing the
+digits.  For now this change will not be reflected in f2c.ps .
+
+Tue Jan 29 16:23:45 EST 1991:
+  Arrange for character-valued statement functions to give results of
+the right length (that of the statement function's name).
+
+Wed Jan 30 07:05:32 EST 1991:
+  More tweaks for character-valued statement functions: an error
+check and an adjustment so a right-hand side of nonconstant length
+(e.g., a substring) is handled right.
+
+Wed Jan 30 09:49:36 EST 1991:
+  Fix p1_head to avoid printing (char *)0 with %s.
+
+Thu Jan 31 13:53:44 EST 1991:
+  Add a test after the cleanup call generated for I/O statements with
+ERR= or END= clauses to catch the unlikely event that the cleanup
+routine encounters an error.
+
+Mon Feb  4 08:00:58 EST 1991:
+  Minor cleanup: omit unneeded jumps and labels from code generated for
+some NAMELIST READs and WRITEs with IOSTAT=, ERR=, and/or END=.
+
+Tue Feb  5 01:39:36 EST 1991:
+  Change Mktemp to mktmp (for the benefit of systems so brain-damaged
+that they do not distinguish case in external names -- and that for
+some reason want to load mktemp).  Try to get xsum0.out right this
+time (it somehow didn't get updated on 4 Feb. 1991).
+  Add note to libi77/README about adjusting the interpretation of
+RECL= specifiers in OPENs for direct unformatted I/O.
+
+Thu Feb  7 17:24:42 EST 1991:
+  New option -r casts values of REAL functions, including intrinsics,
+to REAL.  This only matters for unportable code like
+	real r
+	r = asin(1.)
+	if (r .eq. asin(1.)) ...
+[The behavior of such code varies with the Fortran compiler used --
+and sometimes is affected by compiler options.]  For now, the man page
+at the end of f2c.ps is the only part of f2c.ps that reflects this new
+option.
+
+Fri Feb  8 18:12:51 EST 1991:
+  Cast pointer differences passed as arguments to the appropriate type.
+This matters, e.g., with MSDOS compilers that yield a long pointer
+difference but have int == short.
+  Disallow nonpositive dimensions.
+
+Fri Feb 15 12:24:15 EST 1991:
+  Change %d to %ld in sprintf call in putpower in putpcc.c.
+  Free more memory (e.g. allowing translation of larger Fortran
+files under MS-DOS).
+  Recognize READ (character expression) and WRITE (character expression)
+as formatted I/O with the format given by the character expression.
+  Update year in Notice.
+
+Sat Feb 16 00:42:32 EST 1991:
+  Recant recognizing WRITE(character expression) as formatted output
+-- Fortran 77 is not symmetric in its syntax for READ and WRITE.
+
+Mon Mar  4 15:19:42 EST 1991:
+  Fix bug in passing the real part of a complex argument to an intrinsic
+function.  Omit unneeded parentheses in nested calls to intrinsics.
+Example:
+	subroutine foo(x, y)
+	complex y
+	x = exp(sin(real(y))) + exp(imag(y))
+	end
+
+Fri Mar  8 15:05:42 EST 1991:
+  Fix a comment in expr.c; omit safstrncpy.c (which had bugs in
+cases not used by f2c).
+
+Wed Mar 13 02:27:23 EST 1991:
+  Initialize firstmemblock->next in mem_init in mem.c .  [On most
+systems it was fortuituously 0, but with System V, -lmalloc could
+trip on this missed initialization.]
+
+Wed Mar 13 11:47:42 EST 1991:
+  Fix a reference to freed memory.
+
+Wed Mar 27 00:42:19 EST 1991:
+  Fix a memory fault caused by such illegal Fortran as
+       function foo
+       x = 3
+       logical foo	! declaration among executables
+       foo=.false.	! used to suffer memory fault
+       end
+
+Fri Apr  5 08:30:31 EST 1991:
+  Fix loss of % in some format expressions, e.g.
+	write(*,'(1h%)')
+  Fix botch introduced 27 March 1991 that caused subroutines with
+multiple entry points to have extraneous declarations of ret_val.
+
+Fri Apr  5 12:44:02 EST 1991
+  Try again to omit extraneous ret_val declarations -- this morning's
+fix was sometimes wrong.
+
+Mon Apr  8 13:47:06 EDT 1991:
+  Arrange for s_rnge to have the right prototype under -A -C .
+
+Wed Apr 17 13:36:03 EDT 1991:
+  New fatal error message for apparent invocation of a recursive
+statement function.
+
+Thu Apr 25 15:13:37 EDT 1991:
+  F2c and libi77 adjusted so NAMELIST works with -i2.  (I forgot
+about -i2 when adding NAMELIST.)  This required a change to f2c.h
+(that only affects NAMELIST I/O under -i2.)  Man-page description of
+-i2 adjusted to reflect that -i2 stores array lengths in short ints.
+
+Fri Apr 26 02:54:41 EDT 1991:
+  Libi77: fix some bugs in NAMELIST reading of multi-dimensional arrays
+(file rsne.c).
+
+Thu May  9 02:13:51 EDT 1991:
+  Omit a trailing space in expr.c (could cause a false xsum value if
+a mailer drops the trailing blank).
+
+Thu May 16 13:14:59 EDT 1991:
+  Libi77: increase LEFBL in lio.h to overcome a NeXT bug.
+  Tweak for compilers that recognize "nested" comments: inside comments,
+turn /* into /+ (as well as */ into +/).
+
+Sat May 25 11:44:25 EDT 1991:
+  libf77: s_rnge: declare line long int rather than int.
+
+Fri May 31 07:51:50 EDT 1991:
+  libf77: system_: officially return status.
+
+Mon Jun 17 16:52:53 EDT 1991:
+  Minor tweaks: omit unnecessary declaration of strcmp (that caused
+trouble on a system where strcmp was a macro) from misc.c; add
+SHELL = /bin/sh to makefiles.
+  Fix a dereference of null when a CHARACTER*(*) declaration appears
+(illegally) after DATA.  Complain only once per subroutine about
+declarations appearing after DATA.
+
+Mon Jul  1 00:28:13 EDT 1991:
+  Add test and error message for illegal use of subroutine names, e.g.
+      SUBROUTINE ZAP(A)
+      ZAP = A
+      END
+
+Mon Jul  8 21:49:20 EDT 1991:
+  Issue a warning about things like
+	integer i
+	i = 'abc'
+(which is treated as i = ichar('a')).  [It might be nice to treat 'abc'
+as an integer initialized (in a DATA statement) with 'abc', but
+other matters have higher priority.]
+  Render
+	i = ichar('A')
+as
+	i = 'A';
+rather than
+	i = 65;
+(which assumes ASCII).
+
+Fri Jul 12 07:41:30 EDT 1991:
+  Note added to README about erroneous definitions of __STDC__ .
+
+Sat Jul 13 13:38:54 EDT 1991:
+  Fix bugs in double type convesions of complex values, e.g.
+sngl(real(...)) or dble(real(...)) (where ... is complex).
+
+Mon Jul 15 13:21:42 EDT 1991:
+  Fix bug introduced 8 July 1991 that caused erroneous warnings
+"ichar([first char. of] char. string) assumed for conversion to numeric"
+when a subroutine had an array of character strings as an argument.
+
+Wed Aug 28 01:12:17 EDT 1991:
+  Omit an unused function in format.c, an unused variable in proc.c .
+  Under -r8, promote complex to double complex (as the man page claims).
+
+Fri Aug 30 17:19:17 EDT 1991:
+  f2c.ps updated: slightly expand description of intrinsics and,or,xor,
+not; add mention of intrinsics lshift, rshift; add note about f2c
+accepting Fortran 90 inline comments (starting with !); update Cobalt
+Blue address.
+
+Tue Sep 17 07:17:33 EDT 1991:
+  libI77: err.c and open.c modified to use modes "rb" and "wb"
+when (f)opening unformatted files; README updated to point out
+that it may be necessary to change these modes to "r" and "w"
+on some non-ANSI systems.
+
+Tue Oct 15 10:25:49 EDT 1991:
+  Minor tweaks that make some PC compilers happier: insert some
+casts, add args to signal functions.
+  Change -g to emit uncommented #line lines -- and to emit more of them;
+update fc, f2c.1, f2c.1t, f2c.ps to reflect this.
+  Change uchar to Uchar in xsum.c .
+  Bring gram.c up to date.
+
+Thu Oct 17 09:22:05 EDT 1991:
+  libi77: README, fio.h, sue.c, uio.c changed so the length field
+in unformatted sequential records has type long rather than int
+(unless UIOLEN_int is #defined).  This is for systems where sizeof(int)
+can vary, depending on the compiler or compiler options.
+
+Thu Oct 17 13:42:59 EDT 1991:
+  libi77: inquire.c: when MSDOS is defined, don't strcmp units[i].ufnm
+when it is NULL.
+
+Fri Oct 18 15:16:00 EDT 1991:
+  Correct xsum0.out in "all from f2c/src" (somehow botched on 15 Oct.).
+
+Tue Oct 22 18:12:56 EDT 1991:
+  Fix memory fault when a character*(*) argument is used (illegally)
+as a dummy variable in the definition of a statement function.  (The
+memory fault occurred when the statement function was invoked.)
+  Complain about implicit character*(*).
+
+Thu Nov 14 08:50:42 EST 1991:
+  libi77: change uint to Uint in fmt.h, rdfmt.c, wrtfmt.c; this change
+should be invisible unless you're running a brain-damaged system.
+
+Mon Nov 25 19:04:40 EST 1991:
+  libi77: correct botches introduced 17 Oct. 1991 and 14 Nov. 1991
+(change uint to Uint in lwrite.c; other changes that only matter if
+sizeof(int) != sizeof(long)).
+  Add a more meaningful error message when bailing out due to an attempt
+to invoke a COMMON variable as a function.
+
+Sun Dec  1 19:29:24 EST 1991:
+  libi77: uio.c: add test for read failure (seq. unformatted reads);
+adjust an error return from EOF to off end of record.
+
+Tue Dec 10 17:42:28 EST 1991:
+  Add tests to prevent memory faults with bad uses of character*(*).
+
+Thu Dec 12 11:24:41 EST 1991:
+  libi77: fix bug with internal list input that caused the last
+character of each record to be ignored; adjust error message in
+internal formatted input from "end-of-file" to "off end of record"
+if the format specifies more characters than the record contains.
+
+Wed Dec 18 17:48:11 EST 1991:
+  Fix bug in translating nonsensical ichar invocations involving
+concatenations.
+  Fix bug in passing intrinsics lle, llt, lge, lgt as arguments;
+hl_le was being passed rather than l_le, etc.
+  libf77: adjust length parameters from long to ftnlen, for
+compiling with f2c_i2 defined.
+
+Sat Dec 21 15:30:57 EST 1991:
+  Allow DO nnn ... to end with an END DO statement labelled nnn.
+
+Tue Dec 31 13:53:47 EST 1991:
+  Fix bug in handling dimension a(n**3,2) -- pow_ii was called
+incorrectly.
+  Fix bug in translating
+	subroutine x(abc,n)
+	character abc(n)
+	write(abc,'(i10)') 123
+	end
+(omitted declaration and initialiation of abc_dim1).
+  Complain about dimension expressions of such invalid types
+as complex and logical.
+
+Fri Jan 17 11:54:20 EST 1992:
+  Diagnose some illegal uses of main program name (rather than
+memory faulting).
+  libi77:  (1) In list and namelist input, treat "r* ," and "r*,"
+alike (where r is a positive integer constant), and fix a bug in
+handling null values following items with repeat counts (e.g.,
+2*1,,3).  (2) For namelist reading of a numeric array, allow a new
+name-value subsequence to terminate the current one (as though the
+current one ended with the right number of null values).
+(3) [lio.h, lwrite.c]:  omit insignificant zeros in list and namelist
+output.  (Compile with -DOld_list_output to get the old behavior.)
+
+Sat Jan 18 15:58:01 EST 1992:
+  libi77:  make list output consistent with F format by printing .1
+rather than 0.1 (introduced yesterday).
+
+Wed Jan 22 08:32:43 EST 1992:
+  libi77:  add comment to README pointing out preconnection of
+Fortran units 5, 6, 0 to stdin, stdout, stderr (respectively).
+
+Mon Feb  3 11:57:53 EST 1992:
+  libi77:  fix namelist read bug that caused the character following
+a comma to be ignored.
+
+Fri Feb 28 01:04:26 EST 1992:
+  libf77:  fix buggy z_sqrt.c (double precision square root), which
+misbehaved for arguments in the southwest quadrant.
+
+Thu Mar 19 15:05:18 EST 1992:
+  Fix bug (introduced 17 Jan 1992) in handling multiple entry points
+of differing types (with implicitly typed entries appearing after
+the first executable statement).
+  Fix memory fault in the following illegal Fortran:
+        double precision foo(i)
+*	illegal: above should be "double precision function foo(i)"
+        foo = i * 3.2
+        entry moo(i)
+        end
+  Note about ANSI_Libraries (relevant, e.g., to IRIX 4.0.1 and AIX)
+added to README.
+  Abort zero divides during constant simplification.
+
+Sat Mar 21 01:27:09 EST 1992:
+  Tweak ckalloc (misc.c) for systems where malloc(0) = 0; this matters
+for subroutines with multiple entry points but no arguments.
+  Add "struct memblock;" to init.c (irrelevant to most compilers).
+
+Wed Mar 25 13:31:05 EST 1992:
+  Fix bug with IMPLICIT INTEGER*4(...): under -i2 or -I2, the *4 was
+ignored.
+
+Tue May  5 09:53:55 EDT 1992:
+  Tweaks to README; e.g., ANSI_LIbraries changed to ANSI_Libraries .
+
+Wed May  6 23:49:07 EDT 1992
+  Under -A and -C++, have subroutines return 0 (even if they have
+no * arguments).
+  Adjust libi77 (rsne.c and lread.c) for systems where ungetc is
+a macro.  Tweak lib[FI]77/makefile to use unique intermediate file
+names (for parallel makes).
+
+Tue May 19 09:03:05 EDT 1992:
+  Adjust libI77 to make err= work with internal list and formatted I/O.
+
+Sat May 23 18:17:42 EDT 1992:
+  Under -A and -C++, supply "return 0;" after the code generated for
+a STOP statement -- the C compiler doesn't know that s_stop won't
+return.
+  New (mutually exclusive) options:
+	-f	treats all input lines as free-format lines,
+		honoring text that appears after column 72
+		and not padding lines shorter than 72 characters
+		with blanks (which matters if a character string
+		is continued across 2 or more lines).
+	-72	treats text appearing after column 72 as an error.
+
+Sun May 24 09:45:37 EDT 1992:
+  Tweak description of -f in f2c.1 and f2c.1t; update f2c.ps .
+
+Fri May 29 01:17:15 EDT 1992:
+  Complain about externals used as variables.  Example
+	subroutine foo(a,b)
+	external b
+	a = a*b		! illegal use of b; perhaps should be b()
+	end
+
+Mon Jun 15 11:15:27 EDT 1992:
+  Fix bug in handling namelists with names that have underscores.
+
+Sat Jun 27 17:30:59 EDT 1992:
+  Under -A and -C++, end Main program aliases with "return 0;".
+  Under -A and -C++, use .P files and usage in previous subprograms
+in the current file to give prototypes for functions declared EXTERNAL
+but not invoked.
+  Fix memory fault under -d1 -P .
+  Under -A and -C++, cast arguments to the right types in calling
+a function that has been defined in the current file or in a .P file.
+  Fix bug in handling multi-dimensional arrays with array references
+in their leading dimensions.
+  Fix bug in the intrinsic cmplx function when the first argument
+involves an expression for which f2c generates temporary variables,
+e.g. cmplx(abs(real(a)),1.) .
+
+Sat Jul 18 07:36:58 EDT 1992:
+  Fix buglet with -e1c (invisible on most systems) temporary file
+f2c_functions was unlinked before being closed.
+  libf77: fix bugs in evaluating m**n for integer n < 0 and m an
+integer different from 1 or a real or double precision 0.
+Catch SIGTRAP (to print "Trace trap" before aborting).  Programs
+that previously erroneously computed 1 for 0**-1 may now fault.
+Relevant routines: main.c pow_di.c pow_hh.c pow_ii.c pow_ri.c .
+
+Sat Jul 18 08:40:10 EDT 1992:
+  libi77: allow namelist input to end with & (e.g. &end).
+
+Thu Jul 23 00:14:43 EDT 1992
+  Append two underscores rather than one to C keywords used as
+local variables to avoid conflicts with similarly named COMMON blocks.
+
+Thu Jul 23 11:20:55 EDT 1992:
+  libf77, libi77 updated to assume ANSI prototypes unless KR_headers
+is #defined.
+  libi77 now recognizes a Z format item as in Fortran 90;
+the implementation assumes 8-bit bytes and botches character strings
+on little-endian machines (by printing their bytes from right to
+left): expect this bug to persist; fixing it would require a
+change to the I/O calling sequences.
+
+Tue Jul 28 15:18:33 EDT 1992:
+  libi77: insert missed "#ifdef KR_headers" lines around getnum
+header in rsne.c.  Version not updated.
+
+NOTE: "index from f2c" now ends with current timestamps of files in
+"all from f2c/src", sorted by time.  To bring your source up to date,
+obtain source files with a timestamp later than the time shown in your
+version.c.
+
+Fri Aug 14 08:07:09 EDT 1992:
+  libi77: tweak wrt_E in wref.c to avoid signing NaNs.
+
+Sun Aug 23 19:05:22 EDT 1992:
+  fc: supply : after O in getopt invocation (for -O1 -O2 -O3).
+
+Mon Aug 24 18:37:59 EDT 1992:
+  Recant above tweak to fc: getopt is dumber than I thought;
+it's necessary to say -O 1 (etc.).
+  libF77/README: add comments about ABORT, ERF, DERF, ERFC, DERFC,
+GETARG, GETENV, IARGC, SIGNAL, and SYSTEM.
+
+Tue Oct 27 01:57:42 EST 1992:
+  libf77, libi77:
+    1.  Fix botched indirection in signal_.c.
+    2.  Supply missing l_eof = 0 assignment to s_rsne() in rsne.c (so
+end-of-file on other files won't confuse namelist reads of external
+files).
+    3.  Prepend f__ to external names that are only of internal
+interest to lib[FI]77.
+
+Thu Oct 29 12:37:18 EST 1992:
+  libf77: Fix botch in signal_.c when KR_headers is #defined;
+add CFLAGS to makefile.
+  libi77: trivial change to makefile for consistency with
+libF77/makefile.
+
+Wed Feb  3 02:05:16 EST 1993:
+  Recognize types INTEGER*1, LOGICAL*1, LOGICAL*2, INTEGER*8.
+INTEGER*8 is not well tested and will only work reasonably on
+systems where int = 4 bytes, long = 8 bytes; on such systems,
+you'll have to modify f2c.h appropriately, changing integer
+from long to int and adding typedef long longint.  You'll also
+have to compile libI77 with Allow_TYQUAD #defined and adjust
+libF77/makefile to compile pow_qq.c.  In the f2c source, changes
+for INTEGER*8 are delimited by #ifdef TYQUAD ... #endif.  You
+can omit the INTEGER*8 changes by compiling with NO_TYQUAD
+#defined.  Otherwise, the new command-line option -!i8
+disables recognition of INTEGER*8.
+  libf77: add pow_qq.c
+  libi77: add #ifdef Allow_TYQUAD stuff.  Changes for INTEGER*1,
+LOGICAL*1, and LOGICAL*2 came last 23 July 1992.  Fix bug in
+backspace (that only bit when the last character of the second
+or subsequent buffer read was the previous newline).  Guard
+against L_tmpnam being too small in endfile.c.  For MSDOS,
+close and reopen files when copying to truncate.  Lengthen
+LINTW (buffer size in lwrite.c).
+  Add \ to the end of #define lines that get broken.
+  Fix bug in handling NAMELIST of items in EQUIVALENCE.
+  Under -h (or -hd), convert Hollerith to integer in general expressions
+(e.g., assignments), not just when they're passed as arguments, and
+blank-pad rather than 0-pad the Hollerith to a multiple of
+sizeof(integer) or sizeof(doublereal).
+  Add command-line option -s, which instructs f2c preserve multi-
+dimensional subscripts (by emitting and using appropriate #defines).
+  Fix glitch (with default type inferences) in examples like
+	call foo('abc')
+	end
+	subroutine foo(goo)
+	end
+This gave two warning messages:
+	Warning on line 4 of y.f: inconsistent calling sequences for foo:
+	        here 1, previously 2 args and string lengths.
+	Warning on line 4 of y.f: inconsistent calling sequences for foo:
+	        here 2, previously 1 args and string lengths.
+Now the second Warning is suppressed.
+  Complain about all inconsistent arguments, not just the first.
+  Switch to automatic creation of "all from f2c/src".  For folks
+getting f2c source via ftp, this means f2c/src/all.Z is now an
+empty file rather than a bundle.
+  Separate -P and -A: -P no longer implies -A.
+
+Thu Feb  4 00:32:20 EST 1993:
+  Fix some glitches (introduced yesterday) with -h .
+
+Fri Feb  5 01:40:38 EST 1993:
+  Fix bug in types conveyed for namelists (introduced 3 Feb. 1993).
+
+Fri Feb  5 21:26:43 EST 1993:
+  libi77: tweaks to NAMELIST and open (after comments by Harold
+Youngren):
+ 1. Reading a ? instead of &name (the start of a namelist) causes
+    the namelist being sought to be written to stdout (unit 6);
+    to omit this feature, compile rsne.c with -DNo_Namelist_Questions.
+ 2. Reading the wrong namelist name now leads to an error message
+    and an attempt to skip input until the right namelist name is found;
+    to omit this feature, compile rsne.c with -DNo_Bad_Namelist_Skip.
+ 3. Namelist writes now insert newlines before each variable; to omit
+    this feature, compile xwsne.c with -DNo_Extra_Namelist_Newlines.
+ 4. For OPEN of sequential files, ACCESS='APPEND' (or
+    access='anything else starting with "A" or "a"') causes the file to
+    be positioned at end-of-file, so a write will append to the file.
+    (This is nonstandard, but does not require modifying data
+    structures.)
+
+Mon Feb  8 14:40:37 EST 1993:
+  Increase number of continuation lines allowed from 19 to 99,
+and allow changing this limit with -NC (e.g. -NC200 for 200 lines).
+  Treat control-Z (at the beginning of a line) as end-of-file: see
+the new penultimate paragraph of README.
+  Fix a rarely seen glitch that could make an error messages to say
+"line 0".
+
+Tue Feb  9 02:05:40 EST 1993
+  libi77: change some #ifdef MSDOS lines to #ifdef NON_UNIX_STDIO,
+and, in err.c under NON_UNIX_STDIO, avoid close(creat(name,0666))
+when the unit has another file descriptor for name.
+
+Tue Feb  9 17:12:49 EST 1993
+  libi77: more tweaks for NON_UNIX_STDIO: use stdio routines
+rather than open, close, creat, seek, fdopen (except for f__isdev).
+
+Fri Feb 12 15:49:33 EST 1993
+  Update src/gram.c (which was forgotten in the recent updates).
+Most folks regenerate it anyway (wity yacc or bison).
+
+Thu Mar  4 17:07:38 EST 1993
+  Increase default max labels in computed gotos and alternate returns
+to 257, and allow -Nl1234 to specify this number.
+  Tweak put.c to check p->tag == TADDR in realpart() and imagpart().
+  Adjust fc script to allow .r (RATFOR) files and -C (check subscripts).
+  Avoid declaring strchr in niceprintf.c under -DANSI_Libraries .
+  gram.c updated again.
+  libi77: err.c, open.c: take declaration of fdopen from rawio.h.
+
+Sat Mar  6 07:09:11 EST 1993
+  libi77: uio.c: adjust off-end-of-record test for sequential
+unformatted reads to respond to err= rather than end= .
+
+Sat Mar  6 16:12:47 EST 1993
+  Treat scalar arguments of the form (v) and v+0, where v is a variable,
+as expressions: assign to a temporary variable, and pass the latter.
+  gram.c updated.
+
+Mon Mar  8 09:35:38 EST 1993
+  "f2c.h from f2c" updated to add types logical1 and integer1 for
+LOGICAL*1 and INTEGER*1.  ("f2c.h from f2c" is supposed to be the
+same as "f2c.h from f2c/src", which was updated 3 Feb. 1993.)
+
+Mon Mar  8 17:57:55 EST 1993
+  Fix rarely seen bug that could cause strange casts in function
+invocations (revealed by an example with msdos/f2c.exe).
+  msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only).
+
+Fri Mar 12 12:37:01 EST 1993
+  Fix bug with -s in handling subscripts involving min, max, and
+complicated expressions requiring temporaries.
+  Fix bug in handling COMMONs that need padding by a char array.
+  msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only).
+
+Fri Mar 12 17:16:16 EST 1993
+  libf77, libi77: updated for compiling under C++.
+
+Mon Mar 15 16:21:37 EST 1993
+  libi77: more minor tweaks (for -DKR_headers); Version.c not changed.
+
+Thu Mar 18 12:37:30 EST 1993
+  Flag -r (for discarding carriage-returns on systems that end lines
+with carriage-return/newline pairs, e.g. PCs) added to xsum, and
+xsum.c converted to ANSI/ISO syntax (with K&R syntax available with
+-DKR_headers).  [When time permits, the f2c source will undergo a
+similar conversion.]
+  libi77: tweaks to #includes in endfile.c, err.c, open.c, rawio.h;
+Version.c not changed.
+  f2c.ps updated (to pick up revision of 2 Feb. 1993 to f2c.1).
+
+Fri Mar 19 09:19:26 EST 1993
+  libi77: add (char *) casts to malloc and realloc invocations
+in err.c, open.c; Version.c not changed.
+
+Tue Mar 30 07:17:15 EST 1993
+  Fix bug introduced 6 March 1993: possible memory corruption when
+loops in data statements involve constant subscripts, as in
+	 DATA (GUNIT(1,I),I=0,14)/15*-1/
+
+Tue Mar 30 16:17:42 EST 1993
+  Fix bug with -s: (floating-point array item)*(complex item)
+generates an _subscr() reference for the floating-point array,
+but a #define for the _subscr() was omitted.
+
+Tue Apr  6 12:11:22 EDT 1993
+  libi77: adjust error returns for formatted inputs to flush the current
+input line when err= is specified.  To restore the old behavior (input
+left mid-line), either adjust the #definition of errfl in fio.h or omit
+the invocation of f__doend in err__fl (in err.c).
+
+Tue Apr  6 13:30:04 EDT 1993
+  Fix bug revealed in
+	subroutine foo(i)
+	call goo(int(i))
+	end
+which now passes a copy of i, rather than i itself.
+
+Sat Apr 17 11:41:02 EDT 1993
+  Adjust appending of underscores to conform with f2c.ps ("A Fortran
+to C Converter"): names that conflict with C keywords or f2c type
+names now have just one underscore appended (rather than two); add
+"integer1", "logical1", "longint" to the keyword list.
+  Append underscores to names that appear in EQUIVALENCE and are
+component names in a structure declared in f2c.h, thus avoiding a
+problem caused by the #defines emitted for equivalences.  Example:
+	complex a
+	equivalence (i,j)
+	a = 1	! a.i went awry because of #define i
+	j = 2
+	write(*,*) a, i
+	end
+  Adjust line-breaking logic to avoid splitting very long constants
+(and names).  Example:
+	! The next line starts with tab and thus is a free-format line.
+	a=.012345689012345689012345689012345689012345689012345689012345689012345689
+	end
+  Omit extraneous "return 0;" from entry stubs emitted for multiple
+entry points of type character, complex, or double complex.
+
+Sat Apr 17 14:35:05 EDT 1993
+  Fix bug (introduced 4 Feb.) in separating -P from -A that kept f2c
+from re-reading a .P file written without -A or -C++ describing a
+routine with an external argument.  [See the just-added note about
+separating -P from -A in the changes above for 3 Feb. 1993.]
+  Fix bug (type UNKNOWN for V in the example below) revealed by
+	subroutine a()
+	external c
+	call b(c)
+	end
+	subroutine b(v)
+	end
+
+Sun Apr 18 19:55:26 EDT 1993
+  Fix wrong calling sequence for mem() in yesterday's addition to
+equiv.c .
+
+Wed Apr 21 17:39:46 EDT 1993
+  Fix bug revealed in
+
+      ASSIGN 10 TO L1
+      GO TO 20
+ 10   ASSIGN 30 TO L2
+      STOP 10
+
+ 20   ASSIGN 10 TO L2	! Bug here because 10 had been assigned
+			! to another label, then defined.
+      GO TO L2
+ 30   END
+
+Fri Apr 23 18:38:50 EDT 1993
+  Fix bug with -h revealed in
+	CHARACTER*9 FOO
+	WRITE(FOO,'(I6)') 1
+	WRITE(FOO,'(I6)') 2	! struct icilist io___3 botched
+	END
+
+Tue Apr 27 16:08:28 EDT 1993
+  Tweak to makefile: remove "size f2c".
+
+Tue May  4 23:48:20 EDT 1993
+  libf77: tweak signal_ line of f2ch.add .
+
+Tue Jun  1 13:47:13 EDT 1993
+  Fix bug introduced 3 Feb. 1993 in handling multiple entry
+points with differing return types -- the postfix array in proc.c
+needed a new entry for integer*8 (which resulted in wrong
+Multitype suffixes for non-integral types).
+  For (default) K&R C, generate VOID rather than int functions for
+functions of Fortran type character, complex, and double complex.
+  msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only).
+
+Tue Jun  1 23:11:15 EDT 1993
+  f2c.h: add Multitype component g and commented type longint.
+  proc.c: omit "return 0;" from stubs for complex and double complex
+entries (when entries have multiple types); add test to avoid memory
+fault with illegal combinations of entry types.
+
+Mon Jun  7 12:00:47 EDT 1993
+  Fix memory fault in
+	common /c/ m
+	integer m(1)
+	data m(1)/1/, m(2)/2/	! one too many initializers
+	end
+  msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only).
+
+Fri Jun 18 13:55:51 EDT 1993
+  libi77: change type of signal_ in f2ch.add; change type of il in
+union Uint from long to integer (for machines like the DEC Alpha,
+where integer should be the same as int).  Version.c not changed.
+  Tweak gram.dcl and gram.head: add semicolons after some rules that
+lacked them, and remove an extraneous semicolon.  These changes are
+completely transparent to our local yacc programs, but apparently
+matter on some VMS systems.
+
+Wed Jun 23 01:02:56 EDT 1993
+  Update "fc" shell script, and bring f2c.1 and f2c.1t up to date:
+they're meant to be linked with (i.e., the same as) src/f2c.1 and
+src/f2c.1t .  [In the last update of f2c.1* (2 Feb. 1993), only
+src/f2c.1 and src/f2c.1t got changed -- a mistake.]
+
+Wed Jun 23 09:04:31 EDT 1993
+  libi77: fix bug in format reversions for internal writes.
+Example:
+	character*60 lines(2)
+	write(lines,"('n =',i3,2(' more text',i3))") 3, 4, 5, 6
+	write(*,*) 'lines(1) = ', lines(1)
+	write(*,*) 'lines(2) = ', lines(2)
+	end
+gave an error message that began "iio: off end of record", rather
+than giving the correct output:
+
+ lines(1) = n =  3 more text  4 more text  5
+ lines(2) =  more text  6 more text
+
+Thu Aug  5 11:31:14 EDT 1993
+  libi77: lread.c: fix bug in handling repetition counts for logical
+data (during list or namelist input).  Change struct f__syl to
+struct syl (for buggy compilers).
+
+Sat Aug  7 16:05:30 EDT 1993
+  libi77: lread.c (again): fix bug in namelist reading of incomplete
+logical arrays.
+  Fix minor calling-sequence errors in format.c, output.c, putpcc.c:
+should be invisible.
+
+Mon Aug  9 09:12:38 EDT 1993
+  Fix erroneous cast under -A in translating
+	character*(*) function getc()
+	getc(2:3)=' '		!wrong cast in first arg to s_copy
+	end
+  libi77: lread.c: fix bug in namelist reading of an incomplete array
+of numeric data followed by another namelist item whose name starts
+with 'd', 'D', 'e', or 'E'.
+
+Fri Aug 20 13:22:10 EDT 1993
+  Fix bug in do while revealed by
+	subroutine skdig (line, i)
+	character line*(*), ch*1
+	integer i
+	logical isdigit
+	isdigit(ch) = ch.ge.'0' .and. ch.le.'9'
+	do while (isdigit(line(i:i)))	! ch__1[0] was set before
+					! "while(...) {...}"
+		i = i + 1
+		enddo
+	end
+
+Fri Aug 27 08:22:54 EDT 1993
+  Add #ifdefs to avoid declaring atol when it is a macro; version.c
+not updated.
+
+Wed Sep  8 12:24:26 EDT 1993
+  libi77: open.c: protect #include "sys/..." with
+#ifndef NON_UNIX_STDIO; Version date not changed.
+
+Thu Sep  9 08:51:21 EDT 1993
+  Adjust "include" to interpret file names relative to the directory
+of the file that contains the "include".
+
+Fri Sep 24 00:56:12 EDT 1993
+  Fix offset error resulting from repeating the same equivalence
+statement twice.  Example:
+	real a(2), b(2)
+	equivalence (a(2), b(2))
+	equivalence (a(2), b(2))
+	end
+  Increase MAXTOKENLEN (to roughly the largest allowed by ANSI C).
+
+Mon Sep 27 08:55:09 EDT 1993
+  libi77: endfile.c: protect #include "sys/types.h" with
+#ifndef NON_UNIX_STDIO; Version.c not changed.
+
+Fri Oct 15 15:37:26 EDT 1993
+  Fix rarely seen parsing bug illustrated by
+	subroutine foo(xabcdefghij)
+	character*(*) xabcdefghij
+               IF (xabcdefghij.NE.'##') GOTO 40
+ 40	end
+in which the spacing in the IF line is crucial.
+
+Thu Oct 21 13:55:11 EDT 1993
+  Give more meaningful error message (then "unexpected character in
+cds") when constant simplification leads to Infinity or NaN.
+
+Wed Nov 10 15:01:05 EST 1993
+  libi77: backspace.c: adjust, under -DMSDOS, to cope with MSDOS
+text files, as handled by some popular PC C compilers.  Beware:
+the (defective) libraries associated with these compilers assume lines
+end with \r\n (conventional MS-DOS text files) -- and ftell (and
+hence the current implementation of backspace) screws up if lines with
+just \n.
+
+Thu Nov 18 09:37:47 EST 1993
+  Give a better error (than "control stack empty") for an extraneous
+ENDDO.  Example:
+	enddo
+	end
+  Update comments about ftp in "readme from f2c".
+
+Sun Nov 28 17:26:50 EST 1993
+  Change format of time stamp in version.c to yyyymmdd.
+  Sort parameter adjustments (or complain of impossible dependencies)
+so that dummy arguments are referenced only after being adjusted.
+Example:
+	subroutine foo(a,b)
+	integer a(2)		! a must be adjusted before b
+	double precision b(a(1),a(2))
+	call goo(b(3,4))
+	end
+  Adjust structs for initialized common blocks and equivalence classes
+to omit the trailing struct component added to force alignment when
+padding already forces the desired alignment.  Example:
+	PROGRAM TEST
+	COMMON /Z/ A, CC
+	CHARACTER*4 CC
+	DATA cc /'a'/
+	END
+now gives
+	struct {
+	    integer fill_1[1];
+	    char e_2[4];
+	    } z_ = { {0}, {'a', ' ', ' ', ' '} };
+rather than
+struct {
+    integer fill_1[1];
+    char e_2[4];
+    real e_3;
+    } z_ = { {0}, {'a', ' ', ' ', ' '}, (float)0. };
+
+Wed Dec  8 16:24:43 EST 1993
+  Adjust lex.c to recognize # nnn "filename" lines emitted by cpp;
+this affects the file names and line numbers in error messages and
+the #line lines emitted under -g.
+  Under -g, arrange for a file that starts with an executable
+statement to have the first #line line indicate line 1, rather
+than the line number of the END statement ending the main program.
+  Adjust fc script to run files ending in .F through /lib/cpp.
+  Fix bug ("Impossible tag 2") in
+	if (t .eq. (0,2)) write(*,*) 'Bug!'
+	end
+  libi77: iio.c: adjust internal formatted reads to treat short records
+as though padded with blanks (rather than causing an "off end of record"
+error).
+
+Wed Dec 15 15:19:15 EST 1993
+  fc: adjusted for .F files to pass -D and -I options to cpp.
+
+Fri Dec 17 20:03:38 EST 1993
+  Fix botch introduced 28 Nov. 1993 in vax.c; change "version of"
+to "version".
+
+Tue Jan  4 15:39:52 EST 1994
+  msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only).
+
+Wed Jan 19 08:55:19 EST 1994
+  Arrange to accept
+	integer	Nx, Ny, Nz
+	parameter	(Nx = 10, Ny = 20)
+	parameter	(Nz = max(Nx, Ny))
+	integer	c(Nz)
+	call foo(c)
+	end
+rather than complaining "Declaration error for c: adjustable dimension
+on non-argument".  The necessary changes cause some hitherto unfolded
+constant expressions to be folded.
+  Accept BYTE as a synonym for INTEGER*1.
+
+Thu Jan 27 08:57:40 EST 1994
+  Fix botch in changes of 19 Jan. 1994 that broke entry points with
+multi-dimensional array arguments that did not appear in the subprogram
+argument list and whose leading dimensions depend on arguments.
+
+Mon Feb  7 09:24:30 EST 1994
+  Remove artifact in "fc" script that caused -O to be ignored:
+	87c87
+	<		# lcc ignores -O...
+	---
+	>		CFLAGS="$CFLAGS $O"
+
+Sun Feb 20 17:04:58 EST 1994
+  Fix bugs reading .P files for routines with arguments of type
+INTEGER*1, INTEGER*8, LOGICAL*2.
+  Fix glitch in reporting inconsistent arguments for routines involving
+character arguments:  "arg n" had n too large by the number of
+character arguments.
+
+Tue Feb 22 20:50:08 EST 1994
+  Trivial changes to data.c format.c main.c niceprintf.c output.h and
+sysdep.h (consistency improvements).
+  libI77: lread.c: check for NULL return from realloc.
+
+Fri Feb 25 23:56:08 EST 1994
+  output.c, sysdep.h: arrange for -DUSE_DTOA to use dtoa.c and g_fmt.c
+for correctly rounded decimal values on IEEE-arithmetic machines
+(plus machines with VAX and IBM-mainframe arithmetic).  These
+routines are available from netlib's fp directory.
+  msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only); the
+former uses -DUSE_DTOA to keep 12 from printing as 12.000000000000001.
+  vax.c: fix wrong arguments to badtag and frchain introduced
+28 Nov. 1993.
+  Source for f2c converted to ANSI/ISO format, with the K&R format
+available by compilation with -DKR_headers .
+  Arrange for (double precision expression) relop (single precision
+constant) to retain the single-precision nature of the constant.
+Example:
+	double precision t
+	if (t .eq. 0.3) ...
+
+Mon Feb 28 11:40:24 EST 1994
+  README updated to reflect a modification just made to netlib's
+"dtoa.c from fp":
+96a97,105
+> Also add the rule
+>
+> 	dtoa.o: dtoa.c
+> 		$(CC) -c $(CFLAGS) -DMALLOC=ckalloc -DIEEE... dtoa.c
+>
+> (without the initial tab) to the makefile, where IEEE... is one of
+> IEEE_MC68k, IEEE_8087, VAX, or IBM, depending on your machine's
+> arithmetic.  See the comments near the start of dtoa.c.
+>
+
+Sat Mar  5 09:41:52 EST 1994
+  Complain about functions with the name of a previously declared
+common block (which is illegal).
+  New option -d specifies the directory for output .c and .P files;
+f2c.1 and f2c.1t updated.  The former undocumented debug option -dnnn
+is now -Dnnn.
+
+Thu Mar 10 10:21:44 EST 1994
+  libf77: add #undef min and #undef max lines to s_paus.c s_stop.c
+and system_.c; Version.c not changed.
+  libi77: add -DPad_UDread lines to uio.c and explanation to README:
+    Some buggy Fortran programs use unformatted direct I/O to write
+    an incomplete record and later read more from that record than
+    they have written.  For records other than the last, the unwritten
+    portion of the record reads as binary zeros.  The last record is
+    a special case: attempting to read more from it than was written
+    gives end-of-file -- which may help one find a bug.  Some other
+    Fortran I/O libraries treat the last record no differently than
+    others and thus give no help in finding the bug of reading more
+    than was written.  If you wish to have this behavior, compile
+    uio.c with -DPad_UDread .
+Version.c not changed.
+
+Tue Mar 29 17:27:54 EST 1994
+  Adjust make_param so dimensions involving min, max, and other
+complicated constant expressions do not provoke error messages
+about adjustable dimensions on non-arguments.
+  Fix botch introduced 19 Jan 1994: "adjustable dimension on non-
+argument" messages could cause some things to be freed twice.
+
+Tue May 10 07:55:12 EDT 1994
+  Trivial changes to exec.c, p1output.c, parse_args.c, proc.c,
+and putpcc.c: change arguments from
+	type foo[]
+to
+	type *foo
+for consistency with defs.h.  For most compilers, this makes no
+difference.
+
+Thu Jun  2 12:18:18 EDT 1994
+  Fix bug in handling FORMAT statements that have adjacent character
+(or Hollerith) strings: an extraneous \002 appeared between the
+strings.
+  libf77: under -DNO_ONEXIT, arrange for f_exit to be called just
+once; previously, upon abnormal termination (including stop statements),
+it was called twice.
+
+Mon Jun  6 15:52:57 EDT 1994
+  libf77: Avoid references to SIGABRT and SIGIOT if neither is defined;
+Version.c not changed.
+  libi77: Add cast to definition of errfl() in fio.h; this only matters
+on systems with sizeof(int) < sizeof(long).  Under -DNON_UNIX_STDIO,
+use binary mode for direct formatted files (to avoid any confusion
+connected with \n characters).
+
+Fri Jun 10 16:47:31 EDT 1994
+  Fix bug under -A in handling unreferenced (and undeclared)
+external arguments in subroutines with multiple entry points.  Example:
+	subroutine m(fcn,futil)
+	external fcn,futil
+	call fcn
+	entry mintio(i1) ! (D_fp)0 rather than (U_fp)0 for futil
+	end
+
+Wed Jun 15 10:38:14 EDT 1994
+  Allow char(constant expression) function in parameter declarations.
+(This was probably broken in the changes of 29 March 1994.)
+
+Fri Jul  1 23:54:00 EDT 1994
+  Minor adjustments to makefile (rule for f2c.1 commented out) and
+sysdep.h (#undef KR_headers if __STDC__ is #defined, and base test
+for ANSI_Libraries and ANSI_Prototypes on KR_headers rather than
+__STDC__); version.c touched but not changed.
+  libi77: adjust fp.h so local.h is only needed under -DV10;
+Version.c not changed.
+
+Tue Jul  5 03:05:46 EDT 1994
+  Fix segmentation fault in
+	subroutine foo(a,b,k)
+	data i/1/
+	double precision a(k,1)	! sequence error: must precede data
+	b = a(i,1)
+	end
+  libi77: Fix bug (introduced 6 June 1994?) in reopening files under
+NON_UNIX_STDIO.
+  Fix some error messages caused by illegal Fortran.  Examples:
+* 1.
+	x(i) = 0  !Missing declaration for array x
+	call f(x) !Said Impossible storage class 8 in routine mkaddr
+	end	  !Now says invalid use of statement function x
+* 2.
+	f = g	!No declaration for g; by default it's a real variable
+	call g	!Said invalid class code 2 for function g
+	end	!Now says g cannot be called
+* 3.
+	intrinsic foo	!Invalid intrinsic name
+	a = foo(b)	!Said intrcall: bad intrgroup 0
+	end		!Now just complains about line 1
+
+Tue Jul  5 11:14:26 EDT 1994
+  Fix glitch in handling erroneous statement function declarations.
+Example:
+	a(j(i) - i) = a(j(i) - i) + 1	! bad statement function
+	call foo(a(3))	! Said Impossible type 0 in routine mktmpn
+	end		! Now warns that i and j are not used
+
+Wed Jul  6 17:31:25 EDT 1994
+  Tweak test for statement functions that (illegally) call themselves;
+f2c will now proceed to check for other errors, rather than bailing
+out at the first recursive statement function reference.
+  Warn about but retain divisions by 0 (instead of calling them
+"compiler errors" and quiting).  On IEEE machines, this permits
+	double precision nan, ninf, pinf
+	nan = 0.d0/0.d0
+	pinf = 1.d0/0.d0
+	ninf = -1.d0/0.d0
+	write(*,*) 'nan, pinf, ninf = ', nan, pinf, ninf
+	end
+to print
+	nan, pinf, ninf =   NaN  Infinity -Infinity
+  libi77: wref.c: protect with #ifdef GOOD_SPRINTF_EXPONENT an
+optimization that requires exponents to have 2 digits when 2 digits
+suffice.  lwrite.c wsfe.c (list and formatted external output):
+omit ' ' carriage-control when compiled with -DOMIT_BLANK_CC .
+Off-by-one bug fixed in character count for list output of character
+strings.  Omit '.' in list-directed printing of Nan, Infinity.
+
+Mon Jul 11 13:05:33 EDT 1994
+  src/gram.c updated.
+
+Tue Jul 12 10:24:42 EDT 1994
+  libi77: wrtfmt.c: under G11.4, write 0. as "  .0000    " rather
+than "  .0000E+00".
+
+Thu Jul 14 17:55:46 EDT 1994
+  Fix glitch in changes of 6 July 1994 that could cause erroneous
+"division by zero" warnings (or worse).  Example:
+	subroutine foo(a,b)
+	y = b
+	a = a / y	! erroneous warning of division by zero
+	end
+
+Mon Aug  1 16:45:17 EDT 1994
+  libi77: lread.c rsne.c: for benefit of systems with a buggy stdio.h,
+declare ungetc when neither KR_headers nor ungetc is #defined.
+Version.c not changed.
+
+Wed Aug  3 01:53:00 EDT 1994
+  libi77: lwrite.c (list output): do not insert a newline when
+appending an oversize item to an empty line.
+
+Mon Aug  8 00:51:01 EDT 1994
+  Fix bug (introduced 3 Feb. 1993) that, under -i2, kept LOGICAL*2
+variables from appearing in INQUIRE statements.  Under -I2, allow
+LOGICAL*4 variables to appear in INQUIRE.  Fix intrinsic function
+LEN so it returns a short value under -i2, a long value otherwise.
+  exec.c: fix obscure memory fault possible with bizarre (and highly
+erroneous) DO-loop syntax.
+
+Fri Aug 12 10:45:57 EDT 1994
+  libi77: fix glitch that kept ERR= (in list- or format-directed input)
+from working after a NAMELIST READ.
+
+Thu Aug 25 13:58:26 EDT 1994
+  Suppress -s when -C is specified.
+  Give full pathname (netlib@research.att.com) for netlib in readme and
+src/README.
+
+Wed Sep  7 22:13:20 EDT 1994
+  libi77: typesize.c: adjust to allow types LOGICAL*1, LOGICAL*2,
+INTEGER*1, and (under -DAllow_TYQUAD) INTEGER*8 in NAMELISTs.
+
+Fri Sep 16 17:50:18 EDT 1994
+  Change name adjustment for reserved words: instead of just appending
+"_" (a single underscore), append "_a_" to local variable names to avoid
+trouble when a common block is named a reserved word and the same
+reserved word is also a local variable name.  Example:
+	common /const/ a,b,c
+	real const(3)
+	equivalence (const(1),a)
+	a = 1.234
+	end
+  Arrange for ichar() to treat characters as unsigned.
+  libf77: s_cmp.c: treat characters as unsigned in comparisons.
+These changes for unsignedness only matter for strings that contain
+non-ASCII characters.  Now ichar() should always be >= 0.
+
+Sat Sep 17 11:19:32 EDT 1994
+  fc: set rc=$? before exit (to get exit code right in trap code).
+
+Mon Sep 19 17:49:43 EDT 1994
+  libf77: s_paus.c: flush stderr after PAUSE; add #ifdef MSDOS stuff.
+  libi77: README: point out general need for -DMSDOS under MS-DOS.
+
+Tue Sep 20 11:42:30 EDT 1994
+  Fix bug in comparing identically named common blocks, in which
+all components have the same names and types, but at least one is
+dimensioned (1) and the other is not dimensioned.  Example:
+	subroutine foo
+	common /ab/ a
+	a=1.	!!! translated correctly to ab_1.a = (float)1.;
+	end
+	subroutine goo
+	common /ab/ a(1)
+	a(1)=2.	!!! translated erroneously to ab_1.a[0] = (float)2.
+	end
+
+Tue Sep 27 23:47:34 EDT 1994
+  Fix bug introduced 16 Sept. 1994: don't add _a_ to C keywords
+used as external names.  In fact, return to earlier behavior of
+appending __ to C keywords unless they are used as external names,
+in which case they get just one underscore appended.
+  Adjust constant handling so integer and logical PARAMETERs retain
+type information, particularly under -I2.  Example:
+	SUBROUTINE FOO
+	INTEGER I
+	INTEGER*1 I1
+	INTEGER*2 I2
+	INTEGER*4 I4
+	LOGICAL L
+	LOGICAL*1 L1
+	LOGICAL*2 L2
+	LOGICAL*4 L4
+	PARAMETER (L=.FALSE., L1=.FALSE., L2=.FALSE., L4=.FALSE.)
+	PARAMETER (I=0,I1=0,I2=0,I4=0)
+	CALL DUMMY(I, I1, I2, I4, L, L1, L2, L4)
+	END
+  f2c.1t: Change f\^2c to f2c (omit half-narrow space) in line following
+".SH NAME" for benefit of systems that cannot cope with troff commands
+in this context.
+
+Wed Sep 28 12:45:19 EDT 1994
+  libf77: s_cmp.c fix glitch in -DKR_headers version introduced
+12 days ago.
+
+Thu Oct  6 09:46:53 EDT 1994
+  libi77: util.c: omit f__mvgbt (which is never used).
+  f2c.h: change "long" to "long int" to facilitate the adjustments
+by means of sed described above.  Comment out unused typedef of Long.
+
+Fri Oct 21 18:02:24 EDT 1994
+  libf77: add s_catow.c and adjust README to point out that changing
+"s_cat.o" to "s_catow.o" in the makefile will permit the target of a
+concatenation to appear on its right-hand side (contrary to the
+Fortran 77 Standard and at the cost of some run-time efficiency).
+
+Wed Nov  2 00:03:58 EST 1994
+  Adjust -g output to contain only one #line line per statement,
+inserting \ before the \n ending lines broken because of their
+length [this insertion was recanted 10 Dec. 1994].  This change
+accommodates an idiocy in the ANSI/ISO C standard, which leaves
+undefined the behavior of #line lines that occur within the arguments
+to a macro call.
+
+Wed Nov  2 14:44:27 EST 1994
+  libi77: under compilation with -DALWAYS_FLUSH, flush buffers at
+the end of each write statement, and test (via the return from
+fflush) for write failures, which can be caught with an ERR=
+specifier in the write statement.  This extra flushing slows
+execution, but can abort execution or alter the flow of control
+when a disk fills up.
+  f2c/src/io.c: Add ERR= test to e_wsle invocation (end of
+list-directed external output) to catch write failures when libI77
+is compiled with -DALWAYS_FLUSH.
+
+Thu Nov  3 10:59:13 EST 1994
+  Fix bug in handling dimensions involving certain intrinsic
+functions of constant expressions: the expressions, rather than
+pointers to them, were passed.  Example:
+      subroutine subtest(n,x)
+      real x(2**n,n) ! pow_ii(2,n) was called; now it's pow_ii(&c__2,n)
+      x(2,2)=3.
+      end
+
+Tue Nov  8 23:56:30 EST 1994
+  malloc.c: remove assumption that only malloc calls sbrk.  This
+appears to make malloc.c useful on RS6000 systems.
+
+Sun Nov 13 13:09:38 EST 1994
+  Turn off constant folding of integers used in floating-point
+expressions, so the assignment in
+	subroutine foo(x)
+	double precision x
+	x = x*1000000*500000
+	end
+is rendered as
+	*x = *x * 1000000 * 500000;
+rather than as
+	*x *= 1783793664;
+
+Sat Dec 10 16:31:40 EST 1994
+  Supply a better error message (than "Impossible type 14") for
+	subroutine foo
+	foo = 3
+	end
+  Under -g, convey name of included files to #line lines.
+  Recant insertion of \ introduced (under -g) 2 Nov. 1994.
+
+Thu Dec 15 14:33:55 EST 1994
+  New command-line option -Idir specifies directories in which to
+look for non-absolute include files (after looking in the directory
+of the current input file).  There can be several -Idir options, each
+specifying one directory.  All -Idir options are considered, from
+left to right, until a suitably named file is found.  The -I2 and -I4
+command-line options have precedence, so directories named 2 or 4
+must be spelled by some circumlocation, such as -I./2 .
+  f2c.ps updated to mention the new -Idir option, correct a typo,
+and bring the man page at the end up to date.
+  lex.c: fix bug in reading line numbers in #line lines.
+  fc updated to pass -Idir options to f2c.
+
+Thu Dec 29 09:48:03 EST 1994
+  Fix bug (e.g., addressing fault) in diagnosing inconsistency in
+the type of function eta in the following example:
+	function foo(c1,c2)
+	double complex foo,c1,c2
+	double precision eta
+	foo = eta(c1,c2)
+	end
+	function eta(c1,c2)
+	double complex eta,c1,c2
+	eta = c1*c2
+	end
+
+Mon Jan  2 13:27:26 EST 1995
+  Retain casts for SNGL (or FLOAT) that were erroneously optimized
+away.  Example:
+	subroutine foo(a,b)
+	double precision a,b
+	a = float(b)	! now rendered as *a = (real) (*b);
+	end
+  Use float (rather than double) temporaries in certain expressions
+of type complex.  Example: the temporary for sngl(b) in
+	complex a
+	double precision b
+	a = sngl(b) - (3.,4.)
+is now of type float.
+
+Fri Jan  6 00:00:27 EST 1995
+  Adjust intrinsic function cmplx to act as dcmplx (returning
+double complex rather than complex) if either of its args is of
+type double precision.  The double temporaries used prior to 2 Jan.
+1995 previously gave it this same behavior.
+
+Thu Jan 12 12:31:35 EST 1995
+  Adjust -krd to use double temporaries in some calculations of
+type complex.
+  libf77: pow_[dhiqrz][hiq].c: adjust x**i to work on machines
+that sign-extend right shifts when i is the most negative integer.
+
+Wed Jan 25 00:14:42 EST 1995
+  Fix memory fault in handling overlapping initializations in
+	block data
+	common /zot/ d
+	double precision d(3)
+	character*6 v(4)
+	real r(2)
+	equivalence (d(3),r(1)), (d(1),v(1))
+	data v/'abcdef', 'ghijkl', 'mnopqr', 'stuvwx'/
+	data r/4.,5./
+	end
+  names.c: add "far", "huge", "near" to c_keywords (causing them
+to have __ appended when used as local variables).
+  libf77: add s_copyow.c, an alternative to s_copy.c for handling
+(illegal) character assignments where the right- and left-hand
+sides overlap, as in a(2:4) = a(1:3).
+
+Thu Jan 26 14:21:19 EST 1995
+  libf77: roll s_catow.c and s_copyow.c into s_cat.c and s_copy.c,
+respectively, allowing the left-hand side of a character assignment
+to appear on its right-hand side unless s_cat.c and s_copy.c are
+compiled with -DNO_OVERWRITE (which is a bit more efficient).
+Fortran 77 forbids the left-hand side from participating in the
+right-hand side (of a character assignment), but Fortran 90 allows it.
+  libi77: wref.c: fix glitch in printing the exponent of 0 when
+GOOD_SPRINTF_EXPONENT is not #defined.
+
+Fri Jan 27 12:25:41 EST 1995
+  Under -C++ -ec (or -C++ -e1c), surround struct declarations with
+	#ifdef __cplusplus
+	extern "C" {
+	#endif
+and
+	#ifdef __cplusplus
+	}
+	#endif
+(This isn't needed with cfront, but apparently is necessary with
+some other C++ compilers.)
+  libf77: minor tweak to s_copy.c: copy forward whenever possible
+(for better cache behavior).
+
+Wed Feb  1 10:26:12 EST 1995
+  Complain about parameter statements that assign values to dummy
+arguments, as in
+	subroutine foo(x)
+	parameter(x = 3.4)
+	end
+
+Sat Feb  4 20:22:02 EST 1995
+  fc: omit "lib=/lib/num/lib.lo".
+
+Wed Feb  8 08:41:14 EST 1995
+  Minor changes to exec.c, putpcc.c to avoid "bad tag" or "error
+in frexpr" with certain invalid Fortran.
+
+Sat Feb 11 08:57:39 EST 1995
+  Complain about integer overflows, both in simplifying integer
+expressions, and in converting integers from decimal to binary.
+  Fix a memory fault in putcx1() associated with invalid input.
+
+Thu Feb 23 11:20:59 EST 1995
+  Omit MAXTOKENLEN; realloc token if necessary (to handle very long
+strings).
+
+Fri Feb 24 11:02:00 EST 1995
+  libi77: iio.c: z_getc: insert (unsigned char *) to allow internal
+reading of characters with high-bit set (on machines that sign-extend
+characters).
+
+Tue Mar 14 18:22:42 EST 1995
+  Fix glitch (in io.c) in handling 0-length strings in format
+statements, as in
+	write(*,10)
+ 10	format(' ab','','cd')
+  libi77: lread.c and rsfe.c: adjust s_rsle and s_rsfe to check for
+end-of-file (to prevent infinite loops with empty read statements).
+
+Wed Mar 22 10:01:46 EST 1995
+  f2c.ps: adjust discussion of -P on p. 7 to reflect a change made
+3 Feb. 1993: -P no longer implies -A.
+
+Fri Apr 21 18:35:00 EDT 1995
+  fc script: remove absolute paths (since PATH specifies only standard
+places).  On most systems, it's still necessary to adjust the PATH
+assignment at the start of fc to fit the local conventions.
+
+Fri May 26 10:03:17 EDT 1995
+  fc script: add recognition of -P and .P files.
+  libi77: iio.c: z_wnew: fix bug in handling T format items in internal
+writes whose last item is written to an earlier position than some
+previous item.
+
+Wed May 31 11:39:48 EDT 1995
+  libf77: added subroutine exit(rc) (with integer return code rc),
+which works like a stop statement but supplies rc as the program's
+return code.
+
+Fri Jun  2 11:56:50 EDT 1995
+  Fix memory fault in
+	parameter (x=2.)
+	data x /2./
+	end
+This now elicits two error messages; the second ("too many
+initializers"), though not desirable, seems hard to eliminate
+without considerable hassle.
+
+Mon Jul 17 23:24:20 EDT 1995
+  Fix botch in simplifying constants in certain complex
+expressions.  Example:
+	subroutine foo(s,z)
+	double complex z
+	double precision s, M, P
+	parameter ( M = 100.d0, P = 2.d0 )
+	z = M * M  / s  * dcmplx (1.d0, P/M)
+*** The imaginary part of z was miscomputed ***
+	end
+  Under -ext, complain about nonintegral dimensions.
+
+Fri Jul 21 11:18:36 EDT 1995
+  Fix glitch on line 159 of init.c: change
+	"(shortlogical *)0)",
+to
+	"(shortlogical *)0",
+This affects multiple entry points when some but not all have
+arguments of type logical*2.
+  libi77: adjust lwrite.c, wref.c, wrtfmt.c so compiling with
+-DWANT_LEAD_0 causes formatted writes of floating-point numbers of
+magnitude < 1 to have an explicit 0 before the decimal point (if the
+field-width permits it).  Note that the Fortran 77 Standard leaves it
+up to the implementation whether to supply these superfluous zeros.
+
+Tue Aug  1 09:25:56 EDT 1995
+  Permit real (or double precision) parameters in dimension expressions.
+
+Mon Aug  7 08:04:00 EDT 1995
+  Append "_eqv" rather than just "_" to names that that appear in
+EQUIVALENCE statements as well as structs in f2c.h (to avoid a
+conflict when these names also name common blocks).
+
+Tue Aug  8 12:49:02 EDT 1995
+  Modify yesterday's change: merge st_fields with c_keywords, to
+cope with equivalences introduced to permit initializing numeric
+variables with character data.  DATA statements causing these
+equivalences can appear after executable statements, so the only
+safe course is to rename all local variable with names in the
+former st_fields list.  This has the unfortunate side effect that
+the common local variable "i" will henceforth be renamed "i__".
+
+Wed Aug 30 00:19:32 EDT 1995
+  libf77: add F77_aloc, now used in s_cat and system_ (to allocate
+memory and check for failure in so doing).
+  libi77: improve MSDOS logic in backspace.c.
+
+Wed Sep  6 09:06:19 EDT 1995
+  libf77: Fix return type of system_ (integer) under -DKR_headers.
+  libi77: Move some f_init calls around for people who do not use
+libF77's main(); now open and namelist read statements that are the
+first I/O statements executed should work right in that context.
+Adjust namelist input to treat a subscripted name whose subscripts do
+not involve colons similarly to the name without a subscript:  accept
+several values, stored in successive elements starting at the
+indicated subscript.  Adjust namelist output to quote character
+strings (avoiding confusion with arrays of character strings).
+
+Thu Sep  7 00:36:04 EDT 1995
+  Fix glitch in integer*8 exponentiation function: it's pow_qq, not
+pow_qi.
+  libi77: fix some bugs with -DAllow_TYQUAD (for integer*8); when
+looking for the &name that starts NAMELIST input, treat lines whose
+first nonblank character is something other than &, $, or ? as
+comment lines (i.e., ignore them), unless rsne.c is compiled with
+-DNo_Namelist_Comments.
+
+Thu Sep  7 09:05:40 EDT 1995
+  libi77: rdfmt.c:  one more tweak for -DAllow_TYQUAD.
+
+Tue Sep 19 00:03:02 EDT 1995
+  Adjust handling of floating-point subscript bounds (a questionable
+f2c extension) so subscripts in the generated C are of integral type.
+  Move #define of roundup to proc.c (where its use is commented out);
+version.c left at 19950918.
+
+Wed Sep 20 17:24:19 EDT 1995
+  Fix bug in handling ichar() under -h.
+
+Thu Oct  5 07:52:56 EDT 1995
+  libi77: wrtfmt.c: fix bug with t editing (f__cursor was not always
+zeroed in mv_cur).
+
+Tue Oct 10 10:47:54 EDT 1995
+  Under -ext, warn about X**-Y and X**+Y.  Following the original f77,
+f2c treats these as X**(-Y) and X**(+Y), respectively.  (They are not
+allowed by the official Fortran 77 Standard.)  Some Fortran compilers
+give a bizarre interpretation to larger contexts, making multiplication
+noncommutative: they treat X**-Y*Z as X**(-Y*Z) rather than X**(-Y)*Z,
+which, following the rules of Fortran 77, is the same as (X**(-Y))*Z.
+
+Wed Oct 11 13:27:05 EDT 1995
+  libi77: move defs of f__hiwater, f__svic, f__icptr from wrtfmt.c
+to err.c.  This should work around a problem with buggy loaders and
+sometimes leads to smaller executable programs.
+
+Sat Oct 21 23:54:22 EDT 1995
+  Under -h, fix bug in the treatment of ichar('0') in arithmetic
+expressions.
+  Demote to -dneg (a new command-line option not mentioned in the
+man page) imitation of the original f77's treatment of unary minus
+applied to a REAL operand (yielding a DOUBLE PRECISION result).
+Previously this imitation (which was present for debugging) occurred
+under (the default) -!R.  It is still suppressed by -R.
+
+Tue Nov  7 23:52:57 EST 1995
+  Adjust assigned GOTOs to honor SAVE declarations.
+  Add comments about ranlib to lib[FI]77/README and makefile.
+
+Tue Dec 19 22:54:06 EST 1995
+  libf77: s_cat.c: fix bug when 2nd or later arg overlaps lhs.
+
+Tue Jan  2 17:54:00 EST 1996
+  libi77: rdfmt.c: move #include "ctype.h" up before "stdlib.h"; no
+change to Version.c.
+
+Sun Feb 25 22:20:20 EST 1996
+  Adjust expr.c to permit raising the integer constants 1 and -1 to
+negative constant integral powers.
+  Avoid faulting when -T and -d are not followed by a directory name
+(immediately, without intervening spaces).
+
+Wed Feb 28 12:49:01 EST 1996
+  Fix a glitch in handling complex parameters assigned a "wrong" type.
+Example:
+	complex d, z
+	parameter(z = (0d0,0d0))
+	data d/z/	! elicited "non-constant initializer"
+	call foo(d)
+	end
+
+Thu Feb 29 00:53:12 EST 1996
+  Fix bug in handling character parameters assigned a char() value.
+Example:
+	character*2 b,c
+	character*1 esc
+	parameter(esc = char(27))
+	integer i
+	data (b(i:i),i=1,2)/esc,'a'/
+	data (c(i:i),i=1,2)/esc,'b'/	! memory fault
+	call foo(b,c)
+	end
+
+Fri Mar  1 23:44:51 EST 1996
+  Fix glitch in evaluating .EQ. and .NE. when both operands are
+logical constants (.TRUE. or .FALSE.).
+
+Fri Mar 15 17:29:54 EST 1996
+  libi77: lread.c, rsfe.c: honor END= in READ stmts with empty iolist.
+
+Tue Mar 19 23:08:32 EST 1996
+  lex.c: arrange for a "statement" consisting of a single short bogus
+keyword to elicit an error message showing the whole keyword.  The
+error message formerly omitted the last letter of the bad keyword.
+  libf77: s_cat.c: supply missing break after overlap detection.
+
+Mon May 13 23:35:26 EDT 1996
+  Recognize Fortran 90's /= as a synonym for .NE..  (<> remains a
+synonym for .NE..)
+  Emit an empty int function of no arguments to supply an external
+name to named block data subprograms (so they can be called somewhere
+to force them to be loaded from a library).
+  Fix bug (memory fault) in handling the following illegal Fortran:
+	parameter(i=1)
+	equivalence(i,j)
+	end
+  Treat cdabs, cdcos, cdexp, cdlog, cdsin, and cdsqrt as synonyms for
+the double complex intrinsics zabs, zcos, zexp, zlog, zsin, and zsqrt,
+respectively, unless -cd is specified.
+  Recognize the Fortran 90 bit-manipulation intrinsics btest, iand,
+ibclr, ibits, ibset, ieor, ior, ishft, and ishftc, unless -i90 is
+specified.  Note that iand, ieor, and ior are thus now synonyms for
+"and", "xor", and "or", respectively.
+  Add three macros (bit_test, bit_clear, bit_set) to f2c.h for use
+with btest, ibclr, and ibset, respectively.  Add new functions
+[lq]bit_bits, [lq]bit_shift, and [lq]_bit_cshift to libF77 for
+use with ibits, ishft, and ishftc, respectively.
+  Add integer function ftell(unit) (returning -1 on error) and
+subroutine fseek(unit, offset, whence, *) to libI77 (with branch to
+label * on error).
+
+Tue May 14 23:21:12 EDT 1996
+  Fix glitch (possible memory fault, or worse) in handling multiple
+entry points with names over 28 characters long.
+
+Mon Jun 10 01:20:16 EDT 1996
+  Update netlib E-mail and ftp addresses in f2c/readme and
+f2c/src/readme (which are different files) -- to reflect the upcoming
+breakup of AT&T.
+  libf77: trivial tweaks to F77_aloc.c and system_.c; Version.c not
+changed.
+  libi77: Adjust rsli.c and lread.c so internal list input with too
+few items in the input string will honor end= .
+
+Mon Jun 10 22:59:57 EDT 1996
+  Add Bits_per_Byte to sysdep.h and adjust definition of Table_size
+to depend on Bits_per_Byte (forcing Table_size to be a power of 2); in
+lex.c, change "comstart[c & 0xfff]" to "comstart[c & (Table_size-1)]"
+to avoid an out-of-range subscript on end-of-file.
+
+Wed Jun 12 00:24:28 EDT 1996
+  Fix bug in output.c (dereferencing a freed pointer) revealed in
+	print *		!np in out_call in output.c clobbered by free
+	end		!during out_expr.
+
+Wed Jun 19 08:12:47 EDT 1996
+  f2c.h: add types uinteger, ulongint (for libF77); add qbit_clear
+and qbit_set macros (in a commented-out section) for integer*8.
+  For integer*8, use qbit_clear and qbit_set for ibclr and ibset.
+  libf77: add casts to unsigned in [lq]bitshft.c.
+
+Thu Jun 20 13:30:43 EDT 1996
+  Complain at character*(*) in common (rather than faulting).
+  Fix bug in recognizing hex constants that start with "16#" (e.g.,
+16#1234abcd, which is a synonym for z'1234abcd').
+  Fix bugs in constant folding of expressions involving btest, ibclr,
+and ibset.
+  Fix bug in constant folding of rshift(16#80000000, -31) (on a 32-bit
+machine; more generally, the bug was in constant folding of
+rshift(ibset(0,NBITS-1), 1-NBITS) when f2c runs on a machine with
+long ints having NBITS bits.
+
+Mon Jun 24 07:58:53 EDT 1996
+  Adjust struct Literal and newlabel() function to accommodate huge
+source files (with more than 32767 newlabel() invocations).
+  Omit .c file when the .f file has a missing final end statement.
+
+Wed Jun 26 14:00:02 EDT 1996
+  libi77: Add discussion of MXUNIT (highest allowed Fortran unit number)
+to libI77/README.
+
+Fri Jun 28 14:16:11 EDT 1996
+  Fix glitch with -onetrip: the temporary variable used for nonconstant
+initial loop variable values was recycled too soon.  Example:
+	do i = j+1, k
+		call foo(i+1)	! temp for j+1 was reused here
+		enddo
+	end
+
+Tue Jul  2 16:11:27 EDT 1996
+  formatdata.c: add a 0 to the end of the basetype array (for TYBLANK)
+(an omission that was harmless on most machines).
+  expr.c: fix a dereference of NULL that was only possible with buggy
+input, such as
+	subroutine $sub(s)	! the '$' is erroneous
+	character s*(*)
+	s(1:) = ' '
+	end
+
+Sat Jul  6 00:44:56 EDT 1996
+  Fix glitch in the intrinsic "real" function when applied to a
+complex (or double complex) variable and passed as an argument to
+some intrinsic functions.  Example:
+	complex a
+	b = sqrt(a)
+	end
+  Fix glitch (only visible if you do not use f2c's malloc and the
+malloc you do use is defective in the sense that malloc(0) returns 0)
+in handling include files that end with another include (perhaps
+followed by comments).
+  Fix glitch with character*(*) arguments named "h" and "i" when
+the body of the subroutine invokes the intrinsic LEN function.
+  Arrange that after a previous "f2c -P foo.f" has produced foo.P,
+running "f2c foo.P foo.f" will produce valid C when foo.f contains
+	call sub('1234')
+	end
+	subroutine sub(msg)
+	end
+Specifically, the length argument in "call sub" is now suppressed.
+With or without foo.P, it is also now suppressed when the order of
+subprograms in file foo.f is reversed:
+	subroutine sub(msg)
+	end
+	call sub('1234')
+	end
+  Adjust copyright notices to reflect AT&T breakup.
+
+Wed Jul 10 09:25:49 EDT 1996
+  Fix bug (possible memory fault) in handling erroneously placed
+and inconsistent declarations.  Example that faulted:
+	character*1 w(8)
+	call foo(w)
+	end
+	subroutine foo(m)
+	data h /0.5/
+	integer m(2)	! should be before data
+	end
+  Fix bug (possible fault) in handling illegal "if" constructions.
+Example (that faulted):
+	subroutine foo(i,j)
+	if (i) then		! bug: i is integer, not logical
+	else if (j) then	! bug: j is integer, not logical
+	endif
+	end
+  Fix glitch with character*(*) argument named "ret_len" to a
+character*(*) function.
+
+Wed Jul 10 23:04:16 EDT 1996
+  Fix more glitches in the intrinsic "real" function when applied to a
+complex (or double complex) variable and passed as an argument to
+some intrinsic functions.  Example:
+	complex a, b
+	r = sqrt(real(conjg(a))) + sqrt(real(a*b))
+	end
+
+Thu Jul 11 17:27:16 EDT 1996
+  Fix a memory fault associated with complicated, illegal input.
+Example:
+	subroutine goo
+	character a
+	call foo(a)	! inconsistent with subsequent def and call
+	end
+	subroutine foo(a)
+	end
+	call foo(a)
+	end
+
+Wed Jul 17 19:18:28 EDT 1996
+  Fix yet another case of intrinsic "real" applied to a complex
+argument.  Example:
+	complex a(3)
+	x = sqrt(real(a(2)))	! gave error message about bad tag
+	end
+
+Mon Aug 26 11:28:57 EDT 1996
+  Tweak sysdep.c for non-Unix systems in which process ID's can be
+over 5 digits long.
+
+Tue Aug 27 08:31:32 EDT 1996
+  Adjust the ishft intrinsic to use unsigned right shifts.  (Previously,
+a negative constant second operand resulted in a possibly signed shift.)
+
+Thu Sep 12 14:04:07 EDT 1996
+  equiv.c: fix glitch with -DKR_headers.
+  libi77: fmtlib.c: fix bug in printing the most negative integer.
+
+Fri Sep 13 08:54:40 EDT 1996
+  Diagnose some illegal appearances of substring notation.
+
+Tue Sep 17 17:48:09 EDT 1996
+  Fix fault in handling some complex parameters.  Example:
+	subroutine foo(a)
+	double complex a, b
+	parameter(b = (0,1))
+	a = b	! f2c faulted here
+	end
+
+Thu Sep 26 07:47:10 EDT 1996
+  libi77:  fmt.h:  for formatted writes of negative integer*1 values,
+make ic signed on ANSI systems.  If formatted writes of integer*1
+values trouble you when using a K&R C compiler, switch to an ANSI
+compiler or use a compiler flag that makes characters signed.
+
+Tue Oct  1 14:41:36 EDT 1996
+  Give a better error message when dummy arguments appear in data
+statements.
+
+Thu Oct 17 13:37:22 EDT 1996
+  Fix bug in typechecking arguments to character and complex (or
+double complex) functions; the bug could cause length arguments
+for character arguments to be omitted on invocations appearing
+textually after the first invocation.  For example, in
+	subroutine foo
+	character c
+	complex zot
+	call goo(zot(c), zot(c))
+	end
+the length was omitted from the second invocation of zot, and
+there was an erroneous error message about inconsistent calling
+sequences.
+
+Wed Dec  4 13:59:14 EST 1996
+  Fix bug revealed by
+	subroutine test(cdum,rdum)
+	complex cdum
+	rdum=cos(real(cdum))	! "Unexpected tag 3 in opconv_fudge"
+	end
+  Fix glitch in parsing "DO 10 D0 = 1, 10".
+  Fix glitch in parsing
+	real*8 x
+	real*8 x	! erroneous "incompatible type" message
+	call foo(x)
+	end
+
+Mon Dec  9 23:15:02 EST 1996
+  Fix glitch in parameter adjustments for arrays whose lower
+bound depends on a scalar argument.  Example:
+	subroutine bug(p,z,m,n)
+	integer z(*),m,n
+	double precision p(z(m):z(m) + n)	! p_offset botched
+	call foo(p(0), p(n))
+	end
+  libi77: complain about non-positive rec= in direct read and write
+statements.
+  libf77: trivial adjustments; Version.c not changed.
+
+Wed Feb 12 00:18:03 EST 1997
+  output.c: fix (seldom problematic) glitch in out_call: put parens
+around the ... in a test of the form "if (q->tag == TADDR && ...)".
+  vax.c: fix bug revealed in the "psi_offset =" assignment in the
+following example:
+	subroutine foo(psi,m)
+	integer z(100),m
+	common /a/ z
+	double precision psi(z(m):z(m) + 10)
+	call foo(m+1, psi(0),psi(10))
+	end
+
+Mon Feb 24 23:44:54 EST 1997
+  For consistency with f2c's current treatment of adjacent character
+strings in FORMAT statements, recognize a Hollerith string following
+a string (and merge adjacent strings in FORMAT statements).
+
+Wed Feb 26 13:41:11 EST 1997
+  New libf2c.zip, a combination of the libf77 and libi77 bundles (and
+available only by ftp).
+  libf77: adjust functions with a complex output argument to permit
+aliasing it with input arguments.  (For now, at least, this is just
+for possible benefit of g77.)
+  libi77: tweak to ftell_.c for systems with strange definitions of
+SEEK_SET, etc.
+
+Tue Apr  8 20:57:08 EDT 1997
+  libf77: [cz]_div.c: tweaks invisible on most systems (that may
+improve things slightly with optimized compilation on systems that use
+gratuitous extra precision).
+  libi77: fmt.c: adjust to complain at missing numbers in formats
+(but still treat missing ".nnn" as ".0").
+
+Fri Apr 11 14:05:57 EDT 1997
+  libi77: err.c: attempt to make stderr line buffered rather than
+fully buffered.  (Buffering is needed for format items T and TR.)
+
+Thu Apr 17 22:42:43 EDT 1997
+ libf77: add F77_aloc.o to makefile (and makefile.u in libf2c.zip).
+
+Fri Apr 25 19:32:09 EDT 1997
+ libf77: add [de]time_.c (which may give trouble on some systems).
+
+Tue May 27 09:18:52 EDT 1997
+ libi77: ftell_.c: fix typo that caused the third argument to be
+treated as 2 on some systems.
+
+Mon Jun  9 00:04:37 EDT 1997
+ libi77 (and libf2c.zip): adjust include order in err.c lread.c wref.c
+rdfmt.c to include fmt.h (etc.) after system includes.  Version.c not
+changed.
+
+Mon Jul 21 16:04:54 EDT 1997
+  proc.c: fix glitch in logic for "nonpositive dimension" message.
+  libi77: inquire.c: always include string.h (for possible use with
+-DNON_UNIX_STDIO); Version.c not changed.
+
+Thu Jul 24 17:11:23 EDT 1997
+  Tweak "Notice" to reflect the AT&T breakup -- we missed it when
+updating the copyright notices in the source files last summer.
+  Adjust src/makefile so malloc.o is not used by default, but can
+be specified with "make MALLOC=malloc.o".
+  Add comments to src/README about the "CRAY" T3E.
+
+Tue Aug  5 14:53:25 EDT 1997
+  Add definition of calloc to malloc.c; this makes f2c's malloc
+work on some systems where trouble hitherto arose because references
+to calloc brought in the system's malloc.  (On sensible systems,
+calloc is defined separately from malloc.  To avoid confusion on
+other systems, f2c/malloc.c now defines calloc.)
+  libi77: lread.c: adjust to accord with a change to the Fortran 8X
+draft (in 1990 or 1991) that rescinded permission to elide quote marks
+in namelist input of character data; to get the old behavior, compile
+with F8X_NML_ELIDE_QUOTES #defined.  wrtfmt.o: wrt_G: tweak to print
+the right number of 0's for zero under G format.
diff --git a/gcc/f/runtime/configure b/gcc/f/runtime/configure
new file mode 100755
index 00000000000..dcc60b6e656
--- /dev/null
+++ b/gcc/f/runtime/configure
@@ -0,0 +1,2048 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.12 
+# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+
+# Defaults:
+ac_help=
+ac_default_prefix=/usr/local
+# Any additions from configure.in:
+
+# Initialize some variables set by options.
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+build=NONE
+cache_file=./config.cache
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+# Initialize some other variables.
+subdirs=
+MFLAGS= MAKEFLAGS=
+# Maximum number of lines to put in a shell here document.
+ac_max_here_lines=12
+
+ac_prev=
+for ac_option
+do
+
+  # If the previous option needs an argument, assign it.
+  if test -n "$ac_prev"; then
+    eval "$ac_prev=\$ac_option"
+    ac_prev=
+    continue
+  fi
+
+  case "$ac_option" in
+  -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+  *) ac_optarg= ;;
+  esac
+
+  # Accept the important Cygnus configure options, so we can diagnose typos.
+
+  case "$ac_option" in
+
+  -bindir | --bindir | --bindi | --bind | --bin | --bi)
+    ac_prev=bindir ;;
+  -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+    bindir="$ac_optarg" ;;
+
+  -build | --build | --buil | --bui | --bu)
+    ac_prev=build ;;
+  -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+    build="$ac_optarg" ;;
+
+  -cache-file | --cache-file | --cache-fil | --cache-fi \
+  | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+    ac_prev=cache_file ;;
+  -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+  | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+    cache_file="$ac_optarg" ;;
+
+  -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+    ac_prev=datadir ;;
+  -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+  | --da=*)
+    datadir="$ac_optarg" ;;
+
+  -disable-* | --disable-*)
+    ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
+    # Reject names that are not valid shell variable names.
+    if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
+      { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+    fi
+    ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+    eval "enable_${ac_feature}=no" ;;
+
+  -enable-* | --enable-*)
+    ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
+    # Reject names that are not valid shell variable names.
+    if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
+      { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+    fi
+    ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+    case "$ac_option" in
+      *=*) ;;
+      *) ac_optarg=yes ;;
+    esac
+    eval "enable_${ac_feature}='$ac_optarg'" ;;
+
+  -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+  | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+  | --exec | --exe | --ex)
+    ac_prev=exec_prefix ;;
+  -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+  | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+  | --exec=* | --exe=* | --ex=*)
+    exec_prefix="$ac_optarg" ;;
+
+  -gas | --gas | --ga | --g)
+    # Obsolete; use --with-gas.
+    with_gas=yes ;;
+
+  -help | --help | --hel | --he)
+    # Omit some internal or obsolete options to make the list less imposing.
+    # This message is too long to be a string in the A/UX 3.1 sh.
+    cat << EOF
+Usage: configure [options] [host]
+Options: [defaults in brackets after descriptions]
+Configuration:
+  --cache-file=FILE       cache test results in FILE
+  --help                  print this message
+  --no-create             do not create output files
+  --quiet, --silent       do not print \`checking...' messages
+  --version               print the version of autoconf that created configure
+Directory and file names:
+  --prefix=PREFIX         install architecture-independent files in PREFIX
+                          [$ac_default_prefix]
+  --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX
+                          [same as prefix]
+  --bindir=DIR            user executables in DIR [EPREFIX/bin]
+  --sbindir=DIR           system admin executables in DIR [EPREFIX/sbin]
+  --libexecdir=DIR        program executables in DIR [EPREFIX/libexec]
+  --datadir=DIR           read-only architecture-independent data in DIR
+                          [PREFIX/share]
+  --sysconfdir=DIR        read-only single-machine data in DIR [PREFIX/etc]
+  --sharedstatedir=DIR    modifiable architecture-independent data in DIR
+                          [PREFIX/com]
+  --localstatedir=DIR     modifiable single-machine data in DIR [PREFIX/var]
+  --libdir=DIR            object code libraries in DIR [EPREFIX/lib]
+  --includedir=DIR        C header files in DIR [PREFIX/include]
+  --oldincludedir=DIR     C header files for non-gcc in DIR [/usr/include]
+  --infodir=DIR           info documentation in DIR [PREFIX/info]
+  --mandir=DIR            man documentation in DIR [PREFIX/man]
+  --srcdir=DIR            find the sources in DIR [configure dir or ..]
+  --program-prefix=PREFIX prepend PREFIX to installed program names
+  --program-suffix=SUFFIX append SUFFIX to installed program names
+  --program-transform-name=PROGRAM
+                          run sed PROGRAM on installed program names
+EOF
+    cat << EOF
+Host type:
+  --build=BUILD           configure for building on BUILD [BUILD=HOST]
+  --host=HOST             configure for HOST [guessed]
+  --target=TARGET         configure for TARGET [TARGET=HOST]
+Features and packages:
+  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
+  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]
+  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]
+  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)
+  --x-includes=DIR        X include files are in DIR
+  --x-libraries=DIR       X library files are in DIR
+EOF
+    if test -n "$ac_help"; then
+      echo "--enable and --with options recognized:$ac_help"
+    fi
+    exit 0 ;;
+
+  -host | --host | --hos | --ho)
+    ac_prev=host ;;
+  -host=* | --host=* | --hos=* | --ho=*)
+    host="$ac_optarg" ;;
+
+  -includedir | --includedir | --includedi | --included | --include \
+  | --includ | --inclu | --incl | --inc)
+    ac_prev=includedir ;;
+  -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+  | --includ=* | --inclu=* | --incl=* | --inc=*)
+    includedir="$ac_optarg" ;;
+
+  -infodir | --infodir | --infodi | --infod | --info | --inf)
+    ac_prev=infodir ;;
+  -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+    infodir="$ac_optarg" ;;
+
+  -libdir | --libdir | --libdi | --libd)
+    ac_prev=libdir ;;
+  -libdir=* | --libdir=* | --libdi=* | --libd=*)
+    libdir="$ac_optarg" ;;
+
+  -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+  | --libexe | --libex | --libe)
+    ac_prev=libexecdir ;;
+  -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+  | --libexe=* | --libex=* | --libe=*)
+    libexecdir="$ac_optarg" ;;
+
+  -localstatedir | --localstatedir | --localstatedi | --localstated \
+  | --localstate | --localstat | --localsta | --localst \
+  | --locals | --local | --loca | --loc | --lo)
+    ac_prev=localstatedir ;;
+  -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+  | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+  | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+    localstatedir="$ac_optarg" ;;
+
+  -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+    ac_prev=mandir ;;
+  -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+    mandir="$ac_optarg" ;;
+
+  -nfp | --nfp | --nf)
+    # Obsolete; use --without-fp.
+    with_fp=no ;;
+
+  -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+  | --no-cr | --no-c)
+    no_create=yes ;;
+
+  -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+    no_recursion=yes ;;
+
+  -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+  | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+  | --oldin | --oldi | --old | --ol | --o)
+    ac_prev=oldincludedir ;;
+  -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+  | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+  | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+    oldincludedir="$ac_optarg" ;;
+
+  -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+    ac_prev=prefix ;;
+  -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+    prefix="$ac_optarg" ;;
+
+  -program-prefix | --program-prefix | --program-prefi | --program-pref \
+  | --program-pre | --program-pr | --program-p)
+    ac_prev=program_prefix ;;
+  -program-prefix=* | --program-prefix=* | --program-prefi=* \
+  | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+    program_prefix="$ac_optarg" ;;
+
+  -program-suffix | --program-suffix | --program-suffi | --program-suff \
+  | --program-suf | --program-su | --program-s)
+    ac_prev=program_suffix ;;
+  -program-suffix=* | --program-suffix=* | --program-suffi=* \
+  | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+    program_suffix="$ac_optarg" ;;
+
+  -program-transform-name | --program-transform-name \
+  | --program-transform-nam | --program-transform-na \
+  | --program-transform-n | --program-transform- \
+  | --program-transform | --program-transfor \
+  | --program-transfo | --program-transf \
+  | --program-trans | --program-tran \
+  | --progr-tra | --program-tr | --program-t)
+    ac_prev=program_transform_name ;;
+  -program-transform-name=* | --program-transform-name=* \
+  | --program-transform-nam=* | --program-transform-na=* \
+  | --program-transform-n=* | --program-transform-=* \
+  | --program-transform=* | --program-transfor=* \
+  | --program-transfo=* | --program-transf=* \
+  | --program-trans=* | --program-tran=* \
+  | --progr-tra=* | --program-tr=* | --program-t=*)
+    program_transform_name="$ac_optarg" ;;
+
+  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+  | -silent | --silent | --silen | --sile | --sil)
+    silent=yes ;;
+
+  -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+    ac_prev=sbindir ;;
+  -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+  | --sbi=* | --sb=*)
+    sbindir="$ac_optarg" ;;
+
+  -sharedstatedir | --sharedstatedir | --sharedstatedi \
+  | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+  | --sharedst | --shareds | --shared | --share | --shar \
+  | --sha | --sh)
+    ac_prev=sharedstatedir ;;
+  -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+  | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+  | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+  | --sha=* | --sh=*)
+    sharedstatedir="$ac_optarg" ;;
+
+  -site | --site | --sit)
+    ac_prev=site ;;
+  -site=* | --site=* | --sit=*)
+    site="$ac_optarg" ;;
+
+  -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+    ac_prev=srcdir ;;
+  -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+    srcdir="$ac_optarg" ;;
+
+  -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+  | --syscon | --sysco | --sysc | --sys | --sy)
+    ac_prev=sysconfdir ;;
+  -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+  | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+    sysconfdir="$ac_optarg" ;;
+
+  -target | --target | --targe | --targ | --tar | --ta | --t)
+    ac_prev=target ;;
+  -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+    target="$ac_optarg" ;;
+
+  -v | -verbose | --verbose | --verbos | --verbo | --verb)
+    verbose=yes ;;
+
+  -version | --version | --versio | --versi | --vers)
+    echo "configure generated by autoconf version 2.12"
+    exit 0 ;;
+
+  -with-* | --with-*)
+    ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
+    # Reject names that are not valid shell variable names.
+    if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
+      { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+    fi
+    ac_package=`echo $ac_package| sed 's/-/_/g'`
+    case "$ac_option" in
+      *=*) ;;
+      *) ac_optarg=yes ;;
+    esac
+    eval "with_${ac_package}='$ac_optarg'" ;;
+
+  -without-* | --without-*)
+    ac_package=`echo $ac_option|sed -e 's/-*without-//'`
+    # Reject names that are not valid shell variable names.
+    if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
+      { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+    fi
+    ac_package=`echo $ac_package| sed 's/-/_/g'`
+    eval "with_${ac_package}=no" ;;
+
+  --x)
+    # Obsolete; use --with-x.
+    with_x=yes ;;
+
+  -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+  | --x-incl | --x-inc | --x-in | --x-i)
+    ac_prev=x_includes ;;
+  -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+  | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+    x_includes="$ac_optarg" ;;
+
+  -x-libraries | --x-libraries | --x-librarie | --x-librari \
+  | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+    ac_prev=x_libraries ;;
+  -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+  | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+    x_libraries="$ac_optarg" ;;
+
+  -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
+    ;;
+
+  *)
+    if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
+      echo "configure: warning: $ac_option: invalid host type" 1>&2
+    fi
+    if test "x$nonopt" != xNONE; then
+      { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
+    fi
+    nonopt="$ac_option"
+    ;;
+
+  esac
+done
+
+if test -n "$ac_prev"; then
+  { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
+fi
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# File descriptor usage:
+# 0 standard input
+# 1 file creation
+# 2 errors and warnings
+# 3 some systems may open it to /dev/tty
+# 4 used on the Kubota Titan
+# 6 checking for... messages and results
+# 5 compiler messages saved in config.log
+if test "$silent" = yes; then
+  exec 6>/dev/null
+else
+  exec 6>&1
+fi
+exec 5>./config.log
+
+echo "\
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+" 1>&5
+
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell metacharacters.
+ac_configure_args=
+for ac_arg
+do
+  case "$ac_arg" in
+  -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+  | --no-cr | --no-c) ;;
+  -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+  *" "*|*"	"*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+  ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+  *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+  esac
+done
+
+# NLS nuisances.
+# Only set these to C if already set.  These must not be set unconditionally
+# because not all systems understand e.g. LANG=C (notably SCO).
+# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
+# Non-C LC_CTYPE values break the ctype check.
+if test "${LANG+set}"   = set; then LANG=C;   export LANG;   fi
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
+if test "${LC_CTYPE+set}"    = set; then LC_CTYPE=C;    export LC_CTYPE;    fi
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+
+# A filename unique to this package, relative to the directory that
+# configure is in, which we can look for to find out if srcdir is correct.
+ac_unique_file=libF77/Version.c
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+  ac_srcdir_defaulted=yes
+  # Try the directory containing this script, then its parent.
+  ac_prog=$0
+  ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
+  test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+  srcdir=$ac_confdir
+  if test ! -r $srcdir/$ac_unique_file; then
+    srcdir=..
+  fi
+else
+  ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+  if test "$ac_srcdir_defaulted" = yes; then
+    { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+  else
+    { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+  fi
+fi
+srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+  if test "x$prefix" != xNONE; then
+    CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+  else
+    CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+  fi
+fi
+for ac_site_file in $CONFIG_SITE; do
+  if test -r "$ac_site_file"; then
+    echo "loading site script $ac_site_file"
+    . "$ac_site_file"
+  fi
+done
+
+if test -r "$cache_file"; then
+  echo "loading cache $cache_file"
+  . $cache_file
+else
+  echo "creating cache $cache_file"
+  > $cache_file
+fi
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+  # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+  if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+    ac_n= ac_c='
+' ac_t='	'
+  else
+    ac_n=-n ac_c= ac_t=
+  fi
+else
+  ac_n= ac_c='\c' ac_t=
+fi
+
+
+
+# From configure.in 1.10
+
+# For g77 we'll set CC to point at the built gcc, but this will get it into
+# the makefiles
+# Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:530: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS="${IFS}:"
+  for ac_dir in $PATH; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      ac_cv_prog_CC="gcc"
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+  echo "$ac_t""$CC" 1>&6
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+if test -z "$CC"; then
+  # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:559: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS="${IFS}:"
+  ac_prog_rejected=no
+  for ac_dir in $PATH; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
+        ac_prog_rejected=yes
+	continue
+      fi
+      ac_cv_prog_CC="cc"
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+if test $ac_prog_rejected = yes; then
+  # We found a bogon in the path, so make sure we never use it.
+  set dummy $ac_cv_prog_CC
+  shift
+  if test $# -gt 0; then
+    # We chose a different compiler from the bogus one.
+    # However, it has the same basename, so the bogon will be chosen
+    # first if we set CC to just the basename; use the full file name.
+    shift
+    set dummy "$ac_dir/$ac_word" "$@"
+    shift
+    ac_cv_prog_CC="$@"
+  fi
+fi
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+  echo "$ac_t""$CC" 1>&6
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+  test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
+echo "configure:607: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+cat > conftest.$ac_ext <<EOF
+#line 617 "configure"
+#include "confdefs.h"
+main(){return(0);}
+EOF
+if { (eval echo configure:621: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+  ac_cv_prog_cc_works=yes
+  # If we can't run a trivial program, we are probably using a cross compiler.
+  if (./conftest; exit) 2>/dev/null; then
+    ac_cv_prog_cc_cross=no
+  else
+    ac_cv_prog_cc_cross=yes
+  fi
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  ac_cv_prog_cc_works=no
+fi
+rm -fr conftest*
+
+echo "$ac_t""$ac_cv_prog_cc_works" 1>&6
+if test $ac_cv_prog_cc_works = no; then
+  { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
+fi
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
+echo "configure:641: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
+echo "configure:646: checking whether we are using GNU C" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.c <<EOF
+#ifdef __GNUC__
+  yes;
+#endif
+EOF
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:655: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+  ac_cv_prog_gcc=yes
+else
+  ac_cv_prog_gcc=no
+fi
+fi
+
+echo "$ac_t""$ac_cv_prog_gcc" 1>&6
+
+if test $ac_cv_prog_gcc = yes; then
+  GCC=yes
+  ac_test_CFLAGS="${CFLAGS+set}"
+  ac_save_CFLAGS="$CFLAGS"
+  CFLAGS=
+  echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
+echo "configure:670: checking whether ${CC-cc} accepts -g" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  echo 'void f(){}' > conftest.c
+if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then
+  ac_cv_prog_cc_g=yes
+else
+  ac_cv_prog_cc_g=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_prog_cc_g" 1>&6
+  if test "$ac_test_CFLAGS" = set; then
+    CFLAGS="$ac_save_CFLAGS"
+  elif test $ac_cv_prog_cc_g = yes; then
+    CFLAGS="-g -O2"
+  else
+    CFLAGS="-O2"
+  fi
+else
+  GCC=
+  test "${CFLAGS+set}" = set || CFLAGS="-g"
+fi
+
+if test "$CROSS";then
+  ac_cv_c_cross=yes
+else
+  ac_cv_c_cross=no
+fi
+
+test "$AR" || AR=ar
+
+if test "$RANLIB"; then :
+  
+else
+  RANLIB_TEST=true
+  # Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:712: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test -n "$RANLIB"; then
+  ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS="${IFS}:"
+  for ac_dir in $PATH; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      ac_cv_prog_RANLIB="ranlib"
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+  test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
+fi
+fi
+RANLIB="$ac_cv_prog_RANLIB"
+if test -n "$RANLIB"; then
+  echo "$ac_t""$RANLIB" 1>&6
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+fi
+
+
+
+
+# Sanity check for the cross-compilation case:
+echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
+echo "configure:745: checking how to run the C preprocessor" >&5
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+  CPP=
+fi
+if test -z "$CPP"; then
+if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+    # This must be in double quotes, not single quotes, because CPP may get
+  # substituted into the Makefile and "${CC-cc}" will confuse make.
+  CPP="${CC-cc} -E"
+  # On the NeXT, cc -E runs the code through the compiler's parser,
+  # not just through cpp.
+  cat > conftest.$ac_ext <<EOF
+#line 760 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:766: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+if test -z "$ac_err"; then
+  :
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  CPP="${CC-cc} -E -traditional-cpp"
+  cat > conftest.$ac_ext <<EOF
+#line 777 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:783: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+if test -z "$ac_err"; then
+  :
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  CPP=/lib/cpp
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+  ac_cv_prog_CPP="$CPP"
+fi
+  CPP="$ac_cv_prog_CPP"
+else
+  ac_cv_prog_CPP="$CPP"
+fi
+echo "$ac_t""$CPP" 1>&6
+
+ac_safe=`echo "stdio.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for stdio.h""... $ac_c" 1>&6
+echo "configure:807: checking for stdio.h" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 812 "configure"
+#include "confdefs.h"
+#include <stdio.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:817: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+if test -z "$ac_err"; then
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=yes"
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  :
+else
+  echo "$ac_t""no" 1>&6
+{ echo "configure: error: Can't find stdio.h.
+You must have a usable C system for the target already installed, at least
+including headers and, preferably, the library, before you can configure
+the G77 runtime system.  If necessary, install gcc now with \`LANGUAGES=c',
+then the target library, then build with \`LANGUAGES=f77'." 1>&2; exit 1; }
+fi
+
+
+echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6
+echo "configure:845: checking for ANSI C header files" >&5
+if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 850 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include <float.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:858: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+if test -z "$ac_err"; then
+  rm -rf conftest*
+  ac_cv_header_stdc=yes
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+if test $ac_cv_header_stdc = yes; then
+  # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
+cat > conftest.$ac_ext <<EOF
+#line 875 "configure"
+#include "confdefs.h"
+#include <string.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "memchr" >/dev/null 2>&1; then
+  :
+else
+  rm -rf conftest*
+  ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+  # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
+cat > conftest.$ac_ext <<EOF
+#line 893 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "free" >/dev/null 2>&1; then
+  :
+else
+  rm -rf conftest*
+  ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+  # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
+if test "$cross_compiling" = yes; then
+  :
+else
+  cat > conftest.$ac_ext <<EOF
+#line 914 "configure"
+#include "confdefs.h"
+#include <ctype.h>
+#define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
+#define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
+#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
+int main () { int i; for (i = 0; i < 256; i++)
+if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2);
+exit (0); }
+
+EOF
+if { (eval echo configure:925: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null
+then
+  :
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -fr conftest*
+  ac_cv_header_stdc=no
+fi
+rm -fr conftest*
+fi
+
+fi
+fi
+
+echo "$ac_t""$ac_cv_header_stdc" 1>&6
+if test $ac_cv_header_stdc = yes; then
+  cat >> confdefs.h <<\EOF
+#define STDC_HEADERS 1
+EOF
+
+fi
+
+
+
+echo $ac_n "checking for posix""... $ac_c" 1>&6
+echo "configure:951: checking for posix" >&5
+if eval "test \"`echo '$''{'g77_cv_header_posix'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 956 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <unistd.h>
+#ifdef _POSIX_VERSION
+  yes
+#endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "yes" >/dev/null 2>&1; then
+  rm -rf conftest*
+  g77_cv_header_posix=yes
+else
+  rm -rf conftest*
+  g77_cv_header_posix=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$g77_cv_header_posix" 1>&6
+
+# We can rely on the GNU library being posix-ish.  I guess checking the 
+# header isn't actually like checking the functions, though...
+echo $ac_n "checking for GNU library""... $ac_c" 1>&6
+echo "configure:982: checking for GNU library" >&5
+if eval "test \"`echo '$''{'g77_cv_lib_gnu'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 987 "configure"
+#include "confdefs.h"
+#include <stdio.h>
+#ifdef __GNU_LIBRARY__
+  yes
+#endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "yes" >/dev/null 2>&1; then
+  rm -rf conftest*
+  g77_cv_lib_gnu=yes
+else
+  rm -rf conftest*
+  g77_cv_lib_gnu=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$g77_cv_lib_gnu" 1>&6
+
+# Apparently cygwin needs to be special-cased.
+echo $ac_n "checking for cyg\`win'32""... $ac_c" 1>&6
+echo "configure:1011: checking for cyg\`win'32" >&5
+if eval "test \"`echo '$''{'g77_cv_sys_cygwin32'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1016 "configure"
+#include "confdefs.h"
+#ifdef __CYGWIN32__
+  yes
+#endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "yes" >/dev/null 2>&1; then
+  rm -rf conftest*
+  g77_cv_sys_cygwin32=yes
+else
+  rm -rf conftest*
+  g77_cv_sys_cygwin32=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$g77_cv_sys_cygwin32" 1>&6
+
+ac_safe=`echo "fcntl.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for fcntl.h""... $ac_c" 1>&6
+echo "configure:1039: checking for fcntl.h" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1044 "configure"
+#include "confdefs.h"
+#include <fcntl.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1049: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+if test -z "$ac_err"; then
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=yes"
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  test $g77_cv_header_posix = yes && cat >> confdefs.h <<\EOF
+#define _POSIX_SOURCE 1
+EOF
+
+else
+  echo "$ac_t""no" 1>&6
+cat >> confdefs.h <<\EOF
+#define NO_FCNTL 1
+EOF
+ cat >> confdefs.h <<\EOF
+#define OPEN_DECL 1
+EOF
+
+fi
+
+
+echo $ac_n "checking for working const""... $ac_c" 1>&6
+echo "configure:1082: checking for working const" >&5
+if eval "test \"`echo '$''{'ac_cv_c_const'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1087 "configure"
+#include "confdefs.h"
+
+int main() {
+
+/* Ultrix mips cc rejects this.  */
+typedef int charset[2]; const charset x;
+/* SunOS 4.1.1 cc rejects this.  */
+char const *const *ccp;
+char **p;
+/* NEC SVR4.0.2 mips cc rejects this.  */
+struct point {int x, y;};
+static struct point const zero = {0,0};
+/* AIX XL C 1.02.0.0 rejects this.
+   It does not let you subtract one const X* pointer from another in an arm
+   of an if-expression whose if-part is not a constant expression */
+const char *g = "string";
+ccp = &g + (g ? g-g : 0);
+/* HPUX 7.0 cc rejects these. */
+++ccp;
+p = (char**) ccp;
+ccp = (char const *const *) p;
+{ /* SCO 3.2v4 cc rejects this.  */
+  char *t;
+  char const *s = 0 ? (char *) 0 : (char const *) 0;
+
+  *t++ = 0;
+}
+{ /* Someone thinks the Sun supposedly-ANSI compiler will reject this.  */
+  int x[] = {25, 17};
+  const int *foo = &x[0];
+  ++foo;
+}
+{ /* Sun SC1.0 ANSI compiler rejects this -- but not the above. */
+  typedef const int *iptr;
+  iptr p = 0;
+  ++p;
+}
+{ /* AIX XL C 1.02.0.0 rejects this saying
+     "k.c", line 2.27: 1506-025 (S) Operand must be a modifiable lvalue. */
+  struct s { int j; const int *ap[3]; };
+  struct s *b; b->j = 5;
+}
+{ /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */
+  const int foo = 10;
+}
+
+; return 0; }
+EOF
+if { (eval echo configure:1136: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  ac_cv_c_const=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_c_const=no
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_c_const" 1>&6
+if test $ac_cv_c_const = no; then
+  cat >> confdefs.h <<\EOF
+#define const 
+EOF
+
+fi
+
+echo $ac_n "checking for size_t""... $ac_c" 1>&6
+echo "configure:1157: checking for size_t" >&5
+if eval "test \"`echo '$''{'ac_cv_type_size_t'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1162 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "size_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+  rm -rf conftest*
+  ac_cv_type_size_t=yes
+else
+  rm -rf conftest*
+  ac_cv_type_size_t=no
+fi
+rm -f conftest*
+
+fi
+echo "$ac_t""$ac_cv_type_size_t" 1>&6
+if test $ac_cv_type_size_t = no; then
+  cat >> confdefs.h <<\EOF
+#define size_t unsigned
+EOF
+
+fi
+
+
+echo $ac_n "checking return type of signal handlers""... $ac_c" 1>&6
+echo "configure:1191: checking return type of signal handlers" >&5
+if eval "test \"`echo '$''{'ac_cv_type_signal'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1196 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <signal.h>
+#ifdef signal
+#undef signal
+#endif
+#ifdef __cplusplus
+extern "C" void (*signal (int, void (*)(int)))(int);
+#else
+void (*signal ()) ();
+#endif
+
+int main() {
+int i;
+; return 0; }
+EOF
+if { (eval echo configure:1213: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  ac_cv_type_signal=void
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_type_signal=int
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_type_signal" 1>&6
+cat >> confdefs.h <<EOF
+#define RETSIGTYPE $ac_cv_type_signal
+EOF
+
+
+# we'll get atexit by default
+if test $ac_cv_header_stdc != yes; then
+echo $ac_n "checking for atexit""... $ac_c" 1>&6
+echo "configure:1234: checking for atexit" >&5
+if eval "test \"`echo '$''{'ac_cv_func_atexit'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1239 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char atexit(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char atexit();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_atexit) || defined (__stub___atexit)
+choke me
+#else
+atexit();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1262: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+  rm -rf conftest*
+  eval "ac_cv_func_atexit=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_atexit=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'atexit`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  cat >> confdefs.h <<\EOF
+#define onexit atexit
+EOF
+
+else
+  echo "$ac_t""no" 1>&6
+  cat >> confdefs.h <<\EOF
+#define NO_ONEXIT 1
+EOF
+
+  echo $ac_n "checking for onexit""... $ac_c" 1>&6
+echo "configure:1287: checking for onexit" >&5
+if eval "test \"`echo '$''{'ac_cv_func_onexit'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1292 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char onexit(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char onexit();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_onexit) || defined (__stub___onexit)
+choke me
+#else
+onexit();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1315: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+  rm -rf conftest*
+  eval "ac_cv_func_onexit=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_onexit=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'onexit`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  :
+else
+  echo "$ac_t""no" 1>&6
+echo $ac_n "checking for on_exit""... $ac_c" 1>&6
+echo "configure:1333: checking for on_exit" >&5
+if eval "test \"`echo '$''{'ac_cv_func_on_exit'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1338 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char on_exit(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char on_exit();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_on_exit) || defined (__stub___on_exit)
+choke me
+#else
+on_exit();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1361: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+  rm -rf conftest*
+  eval "ac_cv_func_on_exit=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_on_exit=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'on_exit`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  cat >> confdefs.h <<\EOF
+#define onexit on_exit
+EOF
+
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+fi
+
+fi
+
+else true
+fi
+
+# This should always succeed on unix.
+# Apparently positive result on cygwin loses re. NON_UNIX_STDIO
+# (as of cygwin b18).
+echo $ac_n "checking for fstat""... $ac_c" 1>&6
+echo "configure:1394: checking for fstat" >&5
+if eval "test \"`echo '$''{'ac_cv_func_fstat'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1399 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char fstat(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char fstat();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_fstat) || defined (__stub___fstat)
+choke me
+#else
+fstat();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1422: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+  rm -rf conftest*
+  eval "ac_cv_func_fstat=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_fstat=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'fstat`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  :
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+echo $ac_n "checking need for NON_UNIX_STDIO""... $ac_c" 1>&6
+echo "configure:1442: checking need for NON_UNIX_STDIO" >&5
+if test $g77_cv_sys_cygwin32 = yes || test $ac_cv_func_fstat = no; then
+  echo "$ac_t""yes" 1>&6
+  cat >> confdefs.h <<\EOF
+#define NON_UNIX_STDIO 1
+EOF
+
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+# This is necessary for e.g. Linux:
+echo $ac_n "checking for necessary members of struct FILE""... $ac_c" 1>&6
+echo "configure:1455: checking for necessary members of struct FILE" >&5
+if eval "test \"`echo '$''{'g77_cv_struct_FILE'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1460 "configure"
+#include "confdefs.h"
+#include <stdio.h>
+int main() {
+FILE s; s._ptr; s._base; s._flag;
+; return 0; }
+EOF
+if { (eval echo configure:1467: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  g77_cv_struct_FILE=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  g77_cv_struct_FILE=no
+fi
+rm -f conftest*
+fi
+echo "$ac_t""$g77_cv_struct_FILE" 1>&6
+if test $g77_cv_struct_FILE = no; then
+  cat >> confdefs.h <<\EOF
+#define MISSING_FILE_ELEMS 1
+EOF
+
+fi
+
+echo $ac_n "checking for drem in -lm""... $ac_c" 1>&6
+echo "configure:1487: checking for drem in -lm" >&5
+ac_lib_var=`echo m'_'drem | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  ac_save_LIBS="$LIBS"
+LIBS="-lm  $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1495 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char drem();
+
+int main() {
+drem()
+; return 0; }
+EOF
+if { (eval echo configure:1506: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+  rm -rf conftest*
+  eval "ac_cv_lib_$ac_lib_var=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  cat >> confdefs.h <<\EOF
+#define IEEE_drem 1
+EOF
+
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+
+
+# posix will guarantee the right behaviour for sprintf, else we can't be
+# sure; HEADER_STDC wouldn't be the right check in sunos4, for instance.
+# However, on my sunos4/gcc setup unistd.h leads us wrongly to believe
+# we're posix-conformant, so always do the test.
+echo $ac_n "checking for ansi/posix sprintf result""... $ac_c" 1>&6
+echo "configure:1536: checking for ansi/posix sprintf result" >&5
+if test "$cross_compiling" = yes; then
+  g77_cv_sys_sprintf_ansi=no
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1541 "configure"
+#include "confdefs.h"
+  #include <stdio.h>
+    /* does sprintf return the number of chars transferred? */
+    main () {char foo[2]; (sprintf(foo, "1") == 1) ? exit(0) : exit(1);}
+
+EOF
+if { (eval echo configure:1548: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null
+then
+  g77_cv_sys_sprintf_ansi=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -fr conftest*
+  g77_cv_sys_sprintf_ansi=no
+fi
+rm -fr conftest*
+fi
+
+if eval "test \"`echo '$''{'g77_cv_sys_sprintf_ansi'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  g77_cv_sys_sprintf_ansi=$g77_cv_sys_sprintf_ansi
+fi
+
+if test $ac_cv_c_cross = no; then
+  echo "$ac_t""$g77_cv_sys_sprintf_ansi" 1>&6
+else
+  echo "$ac_t""can't tell -- assuming no" 1>&6
+fi
+# The cygwin patch takes steps to avoid defining USE_STRLEN here -- I don't
+# understand why.
+if test $g77_cv_sys_sprintf_ansi != yes; then 
+  cat >> confdefs.h <<\EOF
+#define USE_STRLEN 1
+EOF
+
+fi
+
+# define NON_ANSI_RW_MODES on unix (can't hurt)
+echo $ac_n "checking NON_ANSI_RW_MODES""... $ac_c" 1>&6
+echo "configure:1582: checking NON_ANSI_RW_MODES" >&5
+cat > conftest.$ac_ext <<EOF
+#line 1584 "configure"
+#include "confdefs.h"
+#ifdef unix
+  yes
+#endif
+#ifdef __unix
+  yes
+#endif
+#ifdef __unix__
+  yes
+#endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "yes" >/dev/null 2>&1; then
+  rm -rf conftest*
+  is_unix=yes
+else
+  rm -rf conftest*
+  is_unix=no
+fi
+rm -f conftest*
+
+if test $g77_cv_sys_cygwin32 = yes; then
+  echo "$ac_t""no" 1>&6
+else
+  if test $is_unix = yes; then
+    cat >> confdefs.h <<\EOF
+#define NON_ANSI_RW_MODES 1
+EOF
+
+    echo "$ac_t""yes" 1>&6
+  else
+    echo "$ac_t""no" 1>&6
+  fi
+fi
+
+# We have to firkle with the info in hconfig.h to figure out suitable types
+# (via com.h).  proj.h and com.h are in $srcdir/.., config.h which they need
+# is in ../.. and the config files are in $srcdir/../../config.
+echo $ac_n "checking f2c integer type""... $ac_c" 1>&6
+echo "configure:1625: checking f2c integer type" >&5
+late_ac_cpp=$ac_cpp
+ac_cpp="$late_ac_cpp -I$srcdir/.. -I../.. -I$srcdir/../.. -I$srcdir/../../config"
+if eval "test \"`echo '$''{'g77_cv_sys_f2cinteger'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1632 "configure"
+#include "confdefs.h"
+#include "proj.h"
+#define FFECOM_DETERMINE_TYPES 1
+#include "com.h"
+#if FFECOM_f2cINTEGER == FFECOM_f2ccodeLONG
+F2C_INTEGER=long int
+#elif FFECOM_f2cINTEGER == FFECOM_f2ccodeINT
+F2C_INTEGER=int
+#else
+#  error "Cannot find a suitable type for F2C_INTEGER"
+#endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "F2C_INTEGER=long int" >/dev/null 2>&1; then
+  rm -rf conftest*
+  g77_cv_sys_f2cinteger="long int"
+fi
+rm -f conftest*
+
+if test "$g77_cv_sys_f2cinteger" = ""; then
+  cat > conftest.$ac_ext <<EOF
+#line 1655 "configure"
+#include "confdefs.h"
+#include "proj.h"
+#define FFECOM_DETERMINE_TYPES 1
+#include "com.h"
+#if FFECOM_f2cINTEGER == FFECOM_f2ccodeLONG
+F2C_INTEGER=long int
+#elif FFECOM_f2cINTEGER == FFECOM_f2ccodeINT
+F2C_INTEGER=int
+#else
+#  error "Cannot find a suitable type for F2C_INTEGER"
+#endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "F2C_INTEGER=int" >/dev/null 2>&1; then
+  rm -rf conftest*
+  g77_cv_sys_f2cinteger=int
+fi
+rm -f conftest*
+
+fi
+if test "$g77_cv_sys_f2cinteger" = ""; then
+  echo "$ac_t""""" 1>&6
+  { echo "configure: error: Can't determine type for f2c integer; config.log may help." 1>&2; exit 1; }
+fi
+
+fi
+
+echo "$ac_t""$g77_cv_sys_f2cinteger" 1>&6
+F2C_INTEGER=$g77_cv_sys_f2cinteger
+ac_cpp=$late_ac_cpp
+
+
+echo $ac_n "checking f2c long int type""... $ac_c" 1>&6
+echo "configure:1690: checking f2c long int type" >&5
+late_ac_cpp=$ac_cpp
+ac_cpp="$late_ac_cpp -I$srcdir/.. -I../.. -I$srcdir/../.. -I$srcdir/../../config"
+if eval "test \"`echo '$''{'g77_cv_sys_f2clongint'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1697 "configure"
+#include "confdefs.h"
+#include "proj.h"
+#define FFECOM_DETERMINE_TYPES 1
+#include "com.h"
+#if FFECOM_f2cLONGINT == FFECOM_f2ccodeLONG
+F2C_LONGINT=long int
+#elif FFECOM_f2cLONGINT == FFECOM_f2ccodeLONGLONG
+F2C_LONGINT=long long int
+#else
+#  error "Cannot find a suitable type for F2C_LONGINT"
+#endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "F2C_LONGINT=long int" >/dev/null 2>&1; then
+  rm -rf conftest*
+  g77_cv_sys_f2clongint="long int"
+fi
+rm -f conftest*
+
+if test "$g77_cv_sys_f2clongint" = ""; then
+  cat > conftest.$ac_ext <<EOF
+#line 1720 "configure"
+#include "confdefs.h"
+#include "proj.h"
+#define FFECOM_DETERMINE_TYPES 1
+#include "com.h"
+#if FFECOM_f2cLONGINT == FFECOM_f2ccodeLONG
+F2C_LONGINT=long int
+#elif FFECOM_f2cLONGINT == FFECOM_f2ccodeLONGLONG
+F2C_LONGINT=long long int
+#else
+#  error "Cannot find a suitable type for F2C_LONGINT"
+#endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "F2C_LONGINT=long long int" >/dev/null 2>&1; then
+  rm -rf conftest*
+  g77_cv_sys_f2clongint="long long int"
+fi
+rm -f conftest*
+
+fi
+if test "$g77_cv_sys_f2clongint" = ""; then
+  echo "$ac_t""""" 1>&6
+  { echo "configure: error: Can't determine type for f2c long int; config.log may help." 1>&2; exit 1; }
+fi
+
+fi
+
+echo "$ac_t""$g77_cv_sys_f2clongint" 1>&6
+F2C_LONGINT=$g77_cv_sys_f2clongint
+ac_cpp=$late_ac_cpp
+
+
+
+
+
+
+# This EOF_CHAR is a misfeature on unix.
+cat >> confdefs.h <<\EOF
+#define NO_EOF_CHAR_CHECK 1
+EOF
+
+
+cat >> confdefs.h <<\EOF
+#define Skip_f2c_Undefs 1
+EOF
+
+
+
+
+
+cat >> confdefs.h <<\EOF
+#define Pad_UDread 1
+EOF
+
+
+
+
+
+cat >> confdefs.h <<\EOF
+#define WANT_LEAD_0 1
+EOF
+
+
+# avoid confusion in case the `makefile's from the f2c distribution have
+# got put here
+test -f libF77/makefile && mv libF77/makefile  libF77/makefile.ori
+test -f libI77/makefile && mv libI77/makefile  libI77/makefile.ori
+test -f libU77/makefile && mv libU77/makefile  libU77/makefile.ori
+
+trap '' 1 2 15
+cat > confcache <<\EOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs.  It is not useful on other systems.
+# If it contains results you don't want to keep, you may remove or edit it.
+#
+# By default, configure uses ./config.cache as the cache file,
+# creating it if it does not exist already.  You can give configure
+# the --cache-file=FILE option to use a different cache file; that is
+# what configure does when it calls configure scripts in
+# subdirectories, so they share the cache.
+# Giving --cache-file=/dev/null disables caching, for debugging configure.
+# config.status only pays attention to the cache file if you give it the
+# --recheck option to rerun configure.
+#
+EOF
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, don't put newlines in cache variables' values.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(set) 2>&1 |
+  case `(ac_space=' '; set) 2>&1` in
+  *ac_space=\ *)
+    # `set' does not quote correctly, so add quotes (double-quote substitution
+    # turns \\\\ into \\, and sed turns \\ into \).
+    sed -n \
+      -e "s/'/'\\\\''/g" \
+      -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
+    ;;
+  *)
+    # `set' quotes correctly as required by POSIX, so do not add quotes.
+    sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
+    ;;
+  esac >> confcache
+if cmp -s $cache_file confcache; then
+  :
+else
+  if test -w $cache_file; then
+    echo "updating cache $cache_file"
+    cat confcache > $cache_file
+  else
+    echo "not updating unwritable cache $cache_file"
+  fi
+fi
+rm -f confcache
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# Any assignment to VPATH causes Sun make to only execute
+# the first set of double-colon rules, so remove it if not needed.
+# If there is a colon in the path, we need to keep it.
+if test "x$srcdir" = x.; then
+  ac_vpsub='/^[ 	]*VPATH[ 	]*=[^:]*$/d'
+fi
+
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+
+# Transform confdefs.h into DEFS.
+# Protect against shell expansion while executing Makefile rules.
+# Protect against Makefile macro expansion.
+cat > conftest.defs <<\EOF
+s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g
+s%[ 	`~#$^&*(){}\\|;'"<>?]%\\&%g
+s%\[%\\&%g
+s%\]%\\&%g
+s%\$%$$%g
+EOF
+DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '`
+rm -f conftest.defs
+
+
+# Without the "./", some shells look in PATH for config.status.
+: ${CONFIG_STATUS=./config.status}
+
+echo creating $CONFIG_STATUS
+rm -f $CONFIG_STATUS
+cat > $CONFIG_STATUS <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# $0 $ac_configure_args
+#
+# Compiler output produced by configure, useful for debugging
+# configure, is in ./config.log if it exists.
+
+ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
+for ac_option
+do
+  case "\$ac_option" in
+  -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+    echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
+    exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
+  -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
+    echo "$CONFIG_STATUS generated by autoconf version 2.12"
+    exit 0 ;;
+  -help | --help | --hel | --he | --h)
+    echo "\$ac_cs_usage"; exit 0 ;;
+  *) echo "\$ac_cs_usage"; exit 1 ;;
+  esac
+done
+
+ac_given_srcdir=$srcdir
+
+trap 'rm -fr `echo "Makefile ../../include/f2c.h:f2c.h.in libI77/Makefile libF77/Makefile libU77/Makefile" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
+$ac_vpsub
+$extrasub
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@DEFS@%$DEFS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@LIBS@%$LIBS%g
+s%@exec_prefix@%$exec_prefix%g
+s%@prefix@%$prefix%g
+s%@program_transform_name@%$program_transform_name%g
+s%@bindir@%$bindir%g
+s%@sbindir@%$sbindir%g
+s%@libexecdir@%$libexecdir%g
+s%@datadir@%$datadir%g
+s%@sysconfdir@%$sysconfdir%g
+s%@sharedstatedir@%$sharedstatedir%g
+s%@localstatedir@%$localstatedir%g
+s%@libdir@%$libdir%g
+s%@includedir@%$includedir%g
+s%@oldincludedir@%$oldincludedir%g
+s%@infodir@%$infodir%g
+s%@mandir@%$mandir%g
+s%@CC@%$CC%g
+s%@AR@%$AR%g
+s%@RANLIB@%$RANLIB%g
+s%@RANLIB_TEST@%$RANLIB_TEST%g
+s%@CPP@%$CPP%g
+s%@F2C_INTEGER@%$F2C_INTEGER%g
+s%@F2C_LONGINT@%$F2C_LONGINT%g
+s%@CROSS@%$CROSS%g
+
+CEOF
+EOF
+
+cat >> $CONFIG_STATUS <<\EOF
+
+# Split the substitutions into bite-sized pieces for seds with
+# small command number limits, like on Digital OSF/1 and HP-UX.
+ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
+ac_file=1 # Number of current file.
+ac_beg=1 # First line for current file.
+ac_end=$ac_max_sed_cmds # Line after last line for current file.
+ac_more_lines=:
+ac_sed_cmds=""
+while $ac_more_lines; do
+  if test $ac_beg -gt 1; then
+    sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
+  else
+    sed "${ac_end}q" conftest.subs > conftest.s$ac_file
+  fi
+  if test ! -s conftest.s$ac_file; then
+    ac_more_lines=false
+    rm -f conftest.s$ac_file
+  else
+    if test -z "$ac_sed_cmds"; then
+      ac_sed_cmds="sed -f conftest.s$ac_file"
+    else
+      ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
+    fi
+    ac_file=`expr $ac_file + 1`
+    ac_beg=$ac_end
+    ac_end=`expr $ac_end + $ac_max_sed_cmds`
+  fi
+done
+if test -z "$ac_sed_cmds"; then
+  ac_sed_cmds=cat
+fi
+EOF
+
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile ../../include/f2c.h:f2c.h.in libI77/Makefile libF77/Makefile libU77/Makefile"}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+  # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+  case "$ac_file" in
+  *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+       ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+  *) ac_file_in="${ac_file}.in" ;;
+  esac
+
+  # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
+
+  # Remove last slash and all that follows it.  Not all systems have dirname.
+  ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+  if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+    # The file is in a subdirectory.
+    test ! -d "$ac_dir" && mkdir "$ac_dir"
+    ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
+    # A "../" for each directory in $ac_dir_suffix.
+    ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
+  else
+    ac_dir_suffix= ac_dots=
+  fi
+
+  case "$ac_given_srcdir" in
+  .)  srcdir=.
+      if test -z "$ac_dots"; then top_srcdir=.
+      else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
+  /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
+  *) # Relative path.
+    srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
+    top_srcdir="$ac_dots$ac_given_srcdir" ;;
+  esac
+
+
+  echo creating "$ac_file"
+  rm -f "$ac_file"
+  configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
+  case "$ac_file" in
+  *Makefile*) ac_comsub="1i\\
+# $configure_input" ;;
+  *) ac_comsub= ;;
+  esac
+
+  ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
+  sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
+fi; done
+rm -f conftest.s*
+
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
+
+
diff --git a/gcc/f/runtime/configure.in b/gcc/f/runtime/configure.in
new file mode 100644
index 00000000000..d2bcebae865
--- /dev/null
+++ b/gcc/f/runtime/configure.in
@@ -0,0 +1,371 @@
+# Process this file with autoconf to produce a configure script.
+#   Copyright (C) 1995, 1997 Free Software Foundation, Inc.
+#   Contributed by Dave Love (d.love@dl.ac.uk).
+#
+#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.
+
+AC_INIT(libF77/Version.c)
+
+AC_REVISION(1.10)
+
+dnl Checks for programs.
+# For g77 we'll set CC to point at the built gcc, but this will get it into
+# the makefiles
+AC_PROG_CC
+dnl AC_C_CROSS
+dnl Gives misleading `(cached)' message from the check.
+if test "$CROSS";then
+  ac_cv_c_cross=yes
+else
+  ac_cv_c_cross=no
+fi
+
+dnl These should be inherited in the recursive make, but ensure they are
+dnl defined:
+test "$AR" || AR=ar
+AC_SUBST(AR)
+if test "$RANLIB"; then :
+  AC_SUBST(RANLIB)
+else
+  RANLIB_TEST=true
+  AC_PROG_RANLIB
+fi
+AC_SUBST(RANLIB_TEST)
+
+dnl not needed for g77?
+dnl AC_PROG_MAKE_SET
+
+dnl Checks for libraries.
+
+dnl Checks for header files.
+# Sanity check for the cross-compilation case:
+AC_CHECK_HEADER(stdio.h,:,
+  [AC_MSG_ERROR([Can't find stdio.h.
+You must have a usable C system for the target already installed, at least
+including headers and, preferably, the library, before you can configure
+the G77 runtime system.  If necessary, install gcc now with \`LANGUAGES=c',
+then the target library, then build with \`LANGUAGES=f77'.])])
+
+AC_HEADER_STDC
+dnl We could do this if we didn't know we were using gcc
+dnl AC_MSG_CHECKING(for prototype-savvy compiler)
+dnl AC_CACHE_VAL(g77_cv_sys_proto,                
+dnl   [AC_TRY_LINK(,                             
+dnl dnl looks screwy because TRY_LINK expects a function body
+dnl    [return 0;} int foo (int * bar) {],       
+dnl    g77_cv_sys_proto=yes,                      
+dnl    [g77_cv_sys_proto=no                       
+dnl     AC_DEFINE(KR_headers)])])                
+dnl AC_MSG_RESULT($g77_cv_sys_proto)              
+
+dnl for U77
+dnl AC_CHECK_HEADERS(unistd.h)
+
+AC_MSG_CHECKING(for posix)
+AC_CACHE_VAL(g77_cv_header_posix,
+  AC_EGREP_CPP(yes,
+  [#include <sys/types.h>
+#include <unistd.h>
+#ifdef _POSIX_VERSION
+  yes
+#endif
+], 
+  g77_cv_header_posix=yes,
+  g77_cv_header_posix=no))
+AC_MSG_RESULT($g77_cv_header_posix)
+
+# We can rely on the GNU library being posix-ish.  I guess checking the 
+# header isn't actually like checking the functions, though...
+AC_MSG_CHECKING(for GNU library)
+AC_CACHE_VAL(g77_cv_lib_gnu,
+  AC_EGREP_CPP(yes,
+    [#include <stdio.h>
+#ifdef __GNU_LIBRARY__
+  yes
+#endif
+], 
+  g77_cv_lib_gnu=yes, g77_cv_lib_gnu=no))
+AC_MSG_RESULT($g77_cv_lib_gnu)
+
+# Apparently cygwin needs to be special-cased.
+AC_MSG_CHECKING([for cyg\`win'32])
+AC_CACHE_VAL(g77_cv_sys_cygwin32,
+  AC_EGREP_CPP(yes,
+  [#ifdef __CYGWIN32__
+  yes
+#endif
+],
+  g77_cv_sys_cygwin32=yes,
+  g77_cv_sys_cygwin32=no))
+AC_MSG_RESULT($g77_cv_sys_cygwin32)
+
+AC_CHECK_HEADER(fcntl.h,
+   test $g77_cv_header_posix = yes && AC_DEFINE(_POSIX_SOURCE),
+   AC_DEFINE(NO_FCNTL) AC_DEFINE(OPEN_DECL))
+
+dnl Checks for typedefs, structures, and compiler characteristics.
+AC_C_CONST
+AC_TYPE_SIZE_T
+
+dnl Checks for library functions.
+AC_TYPE_SIGNAL
+# we'll get atexit by default
+if test $ac_cv_header_stdc != yes; then
+AC_CHECK_FUNC(atexit,
+  AC_DEFINE(onexit,atexit),dnl just in case
+  [AC_DEFINE(NO_ONEXIT)
+  AC_CHECK_FUNC(onexit,,
+    [AC_CHECK_FUNC(on_exit,
+     AC_DEFINE(onexit,on_exit),)])])
+else true
+fi
+
+# This should always succeed on unix.
+# Apparently positive result on cygwin loses re. NON_UNIX_STDIO
+# (as of cygwin b18).
+AC_CHECK_FUNC(fstat)
+AC_MSG_CHECKING([need for NON_UNIX_STDIO])
+if test $g77_cv_sys_cygwin32 = yes || test $ac_cv_func_fstat = no; then
+  AC_MSG_RESULT(yes)
+  AC_DEFINE(NON_UNIX_STDIO)
+else
+  AC_MSG_RESULT(no)
+fi
+
+# This is necessary for e.g. Linux:
+AC_MSG_CHECKING([for necessary members of struct FILE])
+AC_CACHE_VAL(g77_cv_struct_FILE,
+[AC_TRY_COMPILE([#include <stdio.h>],
+  [FILE s; s._ptr; s._base; s._flag;],g77_cv_struct_FILE=yes,
+  g77_cv_struct_FILE=no)])dnl
+AC_MSG_RESULT($g77_cv_struct_FILE)
+if test $g77_cv_struct_FILE = no; then
+  AC_DEFINE(MISSING_FILE_ELEMS)
+fi
+
+dnl perhaps should check also for remainder
+dnl Unfortunately, the message implies we're just checking for -lm...
+AC_CHECK_LIB(m,drem,AC_DEFINE(IEEE_drem))
+
+dnl for U77:
+dnl AC_CHECK_FUNCS(symlink getcwd lstat)
+dnl test $ac_cv_func_symlink = yes && SYMLNK=symlnk_.o
+dnl test $ac_cv_func_lstat = yes && SYMLNK="$SYMLNK lstat_.o"
+dnl AC_SUBST(SYMLNK)
+
+# posix will guarantee the right behaviour for sprintf, else we can't be
+# sure; HEADER_STDC wouldn't be the right check in sunos4, for instance.
+# However, on my sunos4/gcc setup unistd.h leads us wrongly to believe
+# we're posix-conformant, so always do the test.
+AC_MSG_CHECKING(for ansi/posix sprintf result)
+dnl This loses if included as an argument to AC_CACHE_VAL because the
+dnl changequote doesn't take effect and the [] vanish.
+dnl fixme: use cached value
+AC_TRY_RUN(changequote(<<, >>)dnl
+  <<#include <stdio.h>
+    /* does sprintf return the number of chars transferred? */
+    main () {char foo[2]; (sprintf(foo, "1") == 1) ? exit(0) : exit(1);}
+>>changequote([, ]),
+    g77_cv_sys_sprintf_ansi=yes,
+    g77_cv_sys_sprintf_ansi=no,
+    g77_cv_sys_sprintf_ansi=no)
+AC_CACHE_VAL(g77_cv_sys_sprintf_ansi,
+     g77_cv_sys_sprintf_ansi=$g77_cv_sys_sprintf_ansi)
+dnl We get a misleading `(cached)' message...
+if test $ac_cv_c_cross = no; then
+  AC_MSG_RESULT($g77_cv_sys_sprintf_ansi)
+else
+  AC_MSG_RESULT([can't tell -- assuming no])
+fi
+# The cygwin patch takes steps to avoid defining USE_STRLEN here -- I don't
+# understand why.
+if test $g77_cv_sys_sprintf_ansi != yes; then 
+  AC_DEFINE(USE_STRLEN)
+fi
+
+# define NON_ANSI_RW_MODES on unix (can't hurt)
+AC_MSG_CHECKING(NON_ANSI_RW_MODES)
+AC_EGREP_CPP(yes,
+[#ifdef unix
+  yes
+#endif
+#ifdef __unix
+  yes
+#endif
+#ifdef __unix__
+  yes
+#endif
+], is_unix=yes, is_unix=no)
+if test $g77_cv_sys_cygwin32 = yes; then
+  AC_MSG_RESULT(no)
+else
+  if test $is_unix = yes; then
+    AC_DEFINE(NON_ANSI_RW_MODES)
+    AC_MSG_RESULT(yes)
+  else
+    AC_MSG_RESULT(no)
+  fi
+fi
+
+# We have to firkle with the info in hconfig.h to figure out suitable types
+# (via com.h).  proj.h and com.h are in $srcdir/.., config.h which they need
+# is in ../.. and the config files are in $srcdir/../../config.
+AC_MSG_CHECKING(f2c integer type)
+late_ac_cpp=$ac_cpp
+ac_cpp="$late_ac_cpp -I$srcdir/.. -I../.. -I$srcdir/../.. -I$srcdir/../../config"
+AC_CACHE_VAL(g77_cv_sys_f2cinteger,
+AC_EGREP_CPP(F2C_INTEGER=long int,
+[#include "proj.h"
+#define FFECOM_DETERMINE_TYPES 1
+#include "com.h"
+#if FFECOM_f2cINTEGER == FFECOM_f2ccodeLONG
+F2C_INTEGER=long int
+#elif FFECOM_f2cINTEGER == FFECOM_f2ccodeINT
+F2C_INTEGER=int
+#else
+#  error "Cannot find a suitable type for F2C_INTEGER"
+#endif
+],
+ g77_cv_sys_f2cinteger="long int",)
+if test "$g77_cv_sys_f2cinteger" = ""; then
+  AC_EGREP_CPP(F2C_INTEGER=int,
+[#include "proj.h"
+#define FFECOM_DETERMINE_TYPES 1
+#include "com.h"
+#if FFECOM_f2cINTEGER == FFECOM_f2ccodeLONG
+F2C_INTEGER=long int
+#elif FFECOM_f2cINTEGER == FFECOM_f2ccodeINT
+F2C_INTEGER=int
+#else
+#  error "Cannot find a suitable type for F2C_INTEGER"
+#endif
+],
+   g77_cv_sys_f2cinteger=int,)
+fi
+if test "$g77_cv_sys_f2cinteger" = ""; then
+  AC_MSG_RESULT("")
+  AC_MSG_ERROR([Can't determine type for f2c integer; config.log may help.])
+fi
+)
+AC_MSG_RESULT($g77_cv_sys_f2cinteger)
+F2C_INTEGER=$g77_cv_sys_f2cinteger
+ac_cpp=$late_ac_cpp
+AC_SUBST(F2C_INTEGER)
+
+AC_MSG_CHECKING(f2c long int type)
+late_ac_cpp=$ac_cpp
+ac_cpp="$late_ac_cpp -I$srcdir/.. -I../.. -I$srcdir/../.. -I$srcdir/../../config"
+AC_CACHE_VAL(g77_cv_sys_f2clongint,
+AC_EGREP_CPP(F2C_LONGINT=long int,
+[#include "proj.h"
+#define FFECOM_DETERMINE_TYPES 1
+#include "com.h"
+#if FFECOM_f2cLONGINT == FFECOM_f2ccodeLONG
+F2C_LONGINT=long int
+#elif FFECOM_f2cLONGINT == FFECOM_f2ccodeLONGLONG
+F2C_LONGINT=long long int
+#else
+#  error "Cannot find a suitable type for F2C_LONGINT"
+#endif
+],
+ g77_cv_sys_f2clongint="long int",)
+if test "$g77_cv_sys_f2clongint" = ""; then
+  AC_EGREP_CPP(F2C_LONGINT=long long int,
+[#include "proj.h"
+#define FFECOM_DETERMINE_TYPES 1
+#include "com.h"
+#if FFECOM_f2cLONGINT == FFECOM_f2ccodeLONG
+F2C_LONGINT=long int
+#elif FFECOM_f2cLONGINT == FFECOM_f2ccodeLONGLONG
+F2C_LONGINT=long long int
+#else
+#  error "Cannot find a suitable type for F2C_LONGINT"
+#endif
+],
+   g77_cv_sys_f2clongint="long long int",)
+fi
+if test "$g77_cv_sys_f2clongint" = ""; then
+  AC_MSG_RESULT("")
+  AC_MSG_ERROR([Can't determine type for f2c long int; config.log may help.])
+fi
+)
+AC_MSG_RESULT($g77_cv_sys_f2clongint)
+F2C_LONGINT=$g77_cv_sys_f2clongint
+ac_cpp=$late_ac_cpp
+AC_SUBST(F2C_LONGINT)
+
+dnl maybe check for drem/remainder
+
+AC_SUBST(CROSS)
+
+
+# This EOF_CHAR is a misfeature on unix.
+AC_DEFINE(NO_EOF_CHAR_CHECK)
+
+AC_DEFINE(Skip_f2c_Undefs)
+
+dnl Craig had these in f2c.h, but they're only relevant for building libf2c
+dnl anyway.
+
+dnl   For GNU Fortran (g77), we always enable the following behaviors for
+dnl   libf2c, to make things easy on the programmer.  The alternate
+dnl   behaviors have their uses, and g77 might provide them as compiler,
+dnl   rather than library, options, so only a single copy of a shared libf2c
+dnl   need be built for a system.
+
+dnl   This makes unformatted I/O more consistent in relation to other
+dnl   systems.  It is not required by the F77 standard.
+
+AC_DEFINE(Pad_UDread)
+
+dnl   This makes ERR= and IOSTAT= returns work properly in disk-full
+dnl   situations, making things work more as expected.  It slows things
+dnl   down, so g77 will probably someday choose the original implementation
+dnl   on a case-by-case basis when it can be shown to not be necessary
+dnl   (e.g. no ERR= or IOSTAT=) or when it is given the appropriate
+dnl   compile-time option or, perhaps, source-code directive.
+
+dnl AC_DEFINE(ALWAYS_FLUSH)
+
+dnl   Most Fortran implementations do this, so to make it easier
+dnl   to compare the output of g77-compiled programs to those compiled
+dnl   by most other compilers, tell libf2c to put leading zeros in
+dnl   appropriate places on output
+
+AC_DEFINE(WANT_LEAD_0)
+
+# avoid confusion in case the `makefile's from the f2c distribution have
+# got put here
+test -f libF77/makefile && mv libF77/makefile  libF77/makefile.ori
+test -f libI77/makefile && mv libI77/makefile  libI77/makefile.ori
+test -f libU77/makefile && mv libU77/makefile  libU77/makefile.ori
+
+AC_OUTPUT(Makefile ../../include/f2c.h:f2c.h.in libI77/Makefile libF77/Makefile libU77/Makefile)
+
+dnl We might have configuration options to:
+dnl * allow non-standard string concatenation (use libF77 s_catow.o,
+dnl   not s_cat.o)
+dnl * change unit preconnexion in libI77/err.c (f_init.c)
+dnl * -DALWAYS_FLUSH in libI77
+dnl * -DOMIT_BLANK_CC in libI77
+
+dnl Local Variables:
+dnl comment-start: "dnl "
+dnl comment-end: ""
+dnl comment-start-skip: "\\bdnl\\b\\s *"
+dnl End:
diff --git a/gcc/f/runtime/disclaimer.netlib b/gcc/f/runtime/disclaimer.netlib
new file mode 100644
index 00000000000..a11108f83db
--- /dev/null
+++ b/gcc/f/runtime/disclaimer.netlib
@@ -0,0 +1,15 @@
+f2c is a Fortran to C converter under development since 1990 by
+	David M. Gay (then AT&T Bell Labs, now Bell Labs, Lucent Technologies)
+	Stu Feldman (then at Bellcore, now at IBM)
+	Mark Maimone (Carnegie-Mellon University)
+	Norm Schryer (then AT&T Bell Labs, now AT&T Labs)
+Please send bug reports to dmg@research.bell-labs.com .
+
+AT&T, Bellcore and Lucent disclaim all warranties with regard to this
+software, including all implied warranties of merchantability
+and fitness.  In no event shall AT&T, Bellcore or Lucent be liable for
+any special, indirect or consequential damages or any damages
+whatsoever resulting from loss of use, data or profits, whether
+in an action of contract, negligence or other tortious action,
+arising out of or in connection with the use or performance of
+this software.
diff --git a/gcc/f/runtime/f2c.h.in b/gcc/f/runtime/f2c.h.in
new file mode 100644
index 00000000000..90374678100
--- /dev/null
+++ b/gcc/f/runtime/f2c.h.in
@@ -0,0 +1,227 @@
+/* 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) */
+
+#ifndef F2C_INCLUDE
+#define F2C_INCLUDE
+
+/* F2C_INTEGER will normally be `int' but would be `long' on 16-bit systems */
+/* we assume short, float are OK */
+typedef @F2C_INTEGER@ /* long int */ integer;
+typedef unsigned @F2C_INTEGER@ /* long */ uinteger;
+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 @F2C_INTEGER@ /* long int */ logical;
+typedef short int shortlogical;
+typedef char logical1;
+typedef char integer1;
+typedef @F2C_LONGINT@ /* long long */ longint;		/* system-dependent */
+typedef unsigned @F2C_LONGINT@ /* long long */ ulongint;	/* system-dependent */
+#define qbit_clear(a,b)	((a) & ~((ulongint)1 << (b)))
+#define qbit_set(a,b)	((a) |  ((ulongint)1 << (b)))
+
+#define TRUE_ (1)
+#define FALSE_ (0)
+
+/* Extern is for use with -E */
+#ifndef Extern
+#define Extern extern
+#endif
+
+/* I/O stuff */
+
+#ifdef f2c_i2
+#error "f2c_i2 will not work with g77!!!!"
+/* for -i2 */
+typedef short flag;
+typedef short ftnlen;
+typedef short ftnint;
+#else
+typedef @F2C_INTEGER@ /* long int */ flag;
+typedef @F2C_INTEGER@ /* long int */ ftnlen;
+typedef @F2C_INTEGER@ /* long int */ ftnint;
+#endif
+
+/*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;
+
+#define VOID void
+
+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 int 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;
+
+#define abs(x) ((x) >= 0 ? (x) : -(x))
+#define dabs(x) (doublereal)abs(x)
+#define min(a,b) ((a) <= (b) ? (a) : (b))
+#define max(a,b) ((a) >= (b) ? (a) : (b))
+#define dmin(a,b) (doublereal)min(a,b)
+#define dmax(a,b) (doublereal)max(a,b)
+#define bit_test(a,b)	((a) >> (b) & 1)
+#define bit_clear(a,b)	((a) & ~((uinteger)1 << (b)))
+#define bit_set(a,b)	((a) |  ((uinteger)1 << (b)))
+
+/* procedure parameter types for -A and -C++ */
+
+#define F2C_proc_par_types 1
+#ifdef __cplusplus
+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)(...);
+#else
+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)();
+#endif
+/* 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.: */
+
+#ifndef Skip_f2c_Undefs
+/* (No such symbols should be defined in a strict ANSI C compiler.
+   We can avoid trouble with f2c-translated code by using
+   gcc -ansi [-traditional].) */
+#undef cray
+#undef gcos
+#undef mc68010
+#undef mc68020
+#undef mips
+#undef pdp11
+#undef sgi
+#undef sparc
+#undef sun
+#undef sun2
+#undef sun3
+#undef sun4
+#undef u370
+#undef u3b
+#undef u3b2
+#undef u3b5
+#undef unix
+#undef vax
+#endif
+#endif
diff --git a/gcc/f/runtime/f2cext.c b/gcc/f/runtime/f2cext.c
new file mode 100644
index 00000000000..199440975d4
--- /dev/null
+++ b/gcc/f/runtime/f2cext.c
@@ -0,0 +1,565 @@
+/* Copyright (C) 1997 Free Software Foundation, Inc.
+This file is part of GNU Fortran run-time library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+
+#include <f2c.h>
+typedef int (*sig_proc)(int);
+
+#ifdef Labort
+int abort_ (void) {
+    extern int G77_abort_0 (void);
+    return G77_abort_0 ();
+}
+#endif
+
+#ifdef Lderf
+double derf_ (doublereal *x) {
+    extern double G77_derf_0 (doublereal *x);
+    return G77_derf_0 (x);
+}
+#endif
+
+#ifdef Lderfc
+double derfc_ (doublereal *x) {
+    extern double G77_derfc_0 (doublereal *x);
+    return G77_derfc_0 (x);
+}
+#endif
+
+#ifdef Lef1asc
+int ef1asc_ (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) {
+    extern int G77_ef1asc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb);
+    return G77_ef1asc_0 (a, la, b, lb);
+}
+#endif
+
+#ifdef Lef1cmc
+integer ef1cmc_ (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) {
+    extern integer G77_ef1cmc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb);
+    return G77_ef1cmc_0 (a, la, b, lb);
+}
+#endif
+
+/* Note that erf*_ and bes*_ return doublereal, not real, as this
+   is the f2c interface, which is based on K&R C.  */
+
+#ifdef Lerf
+doublereal erf_ (real *x) {
+    extern double G77_erf_0 (real *x);
+    return G77_erf_0 (x);
+}
+#endif
+
+#ifdef Lerfc
+doublereal erfc_ (real *x) {
+    extern double G77_erfc_0 (real *x);
+    return G77_erfc_0 (x);
+}
+#endif
+
+#ifdef Lexit
+void exit_ (integer *rc) {
+    extern void G77_exit_0 (integer *rc);
+    G77_exit_0 (rc);
+}
+#endif
+
+#ifdef Lgetarg
+void getarg_ (ftnint *n, char *s, ftnlen ls) {
+    extern void G77_getarg_0 (ftnint *n, char *s, ftnlen ls);
+    G77_getarg_0 (n, s, ls);
+}
+#endif
+
+#ifdef Lgetenv
+void getenv_ (char *fname, char *value, ftnlen flen, ftnlen vlen) {
+    extern void G77_getenv_0 (char *fname, char *value, ftnlen flen, ftnlen vlen);
+    G77_getenv_0 (fname, value, flen, vlen);
+}
+#endif
+
+#ifdef Liargc
+ftnint iargc_ (void) {
+    extern ftnint G77_iargc_0 (void);
+    return G77_iargc_0 ();
+}
+#endif
+
+#ifdef Lsignal
+ftnint signal_ (integer *sigp, sig_proc proc) {
+    extern ftnint G77_signal_0 (integer *sigp, sig_proc proc);
+    return G77_signal_0 (sigp, proc);
+}
+#endif
+
+#ifdef Lsystem
+integer system_ (char *s, ftnlen n) {
+    extern integer G77_system_0 (char *s, ftnlen n);
+    return G77_system_0 (s, n);
+}
+#endif
+
+#ifdef Lflush
+int flush_ (void) {
+    extern int G77_flush_0 (void);
+    return G77_flush_0 ();
+}
+#endif
+
+#ifdef Lftell
+integer ftell_ (integer *Unit) {
+    extern integer G77_ftell_0 (integer *Unit);
+    return G77_ftell_0 (Unit);
+}
+#endif
+
+#ifdef Lfseek
+integer fseek_ (integer *Unit, integer *offset, integer *xwhence) {
+    extern integer G77_fseek_0 (integer *Unit, integer *offset, integer *xwhence);
+    return G77_fseek_0 (Unit, offset, xwhence);
+}
+#endif
+
+#ifdef Laccess
+integer access_ (const char *name, const char *mode, ftnlen Lname, ftnlen Lmode) {
+    extern integer G77_access_0 (const char *name, const char *mode, ftnlen Lname, ftnlen Lmode);
+    return G77_access_0 (name, mode, Lname, Lmode);
+}
+#endif
+
+#ifdef Lalarm
+integer alarm_ (integer *seconds, sig_proc proc, integer *status) {
+    extern integer G77_alarm_0 (integer *seconds, sig_proc proc);
+    return G77_alarm_0 (seconds, proc);
+}
+#endif
+
+#ifdef Lbesj0
+doublereal besj0_ (const real *x) {
+    return j0 (*x);
+}
+#endif
+
+#ifdef Lbesj1
+doublereal besj1_ (const real *x) {
+    return j1 (*x);
+}
+#endif
+
+#ifdef Lbesjn
+doublereal besjn_ (const integer *n, real *x) {
+    return jn (*n, *x);
+}
+#endif
+
+#ifdef Lbesy0
+doublereal besy0_ (const real *x) {
+    return y0 (*x);
+}
+#endif
+
+#ifdef Lbesy1
+doublereal besy1_ (const real *x) {
+    return y1 (*x);
+}
+#endif
+
+#ifdef Lbesyn
+doublereal besyn_ (const integer *n, real *x) {
+    return yn (*n, *x);
+}
+#endif
+
+#ifdef Lchdir
+integer chdir_ (const char *name, const ftnlen Lname) {
+    extern integer G77_chdir_0 (const char *name, const ftnlen Lname);
+    return G77_chdir_0 (name, Lname);
+}
+#endif
+
+#ifdef Lchmod
+integer chmod_ (const char *name, const char *mode, const ftnlen Lname, const ftnlen Lmode) {
+    extern integer G77_chmod_0 (const char *name, const char *mode, const ftnlen Lname, const ftnlen Lmode);
+    return G77_chmod_0 (name, mode, Lname, Lmode);
+}
+#endif
+
+#ifdef Lctime
+void ctime_ (char *chtime, const ftnlen Lchtime, longint *xstime) {
+    extern void G77_ctime_0 (char *chtime, const ftnlen Lchtime, longint *xstime);
+    G77_ctime_0 (chtime, Lchtime, xstime);
+}
+#endif
+
+#ifdef Ldate
+int date_ (char *buf, ftnlen buf_len) {
+    extern int G77_date_0 (char *buf, ftnlen buf_len);
+    return G77_date_0 (buf, buf_len);
+}
+#endif
+
+#ifdef Ldbesj0
+doublereal dbesj0_ (const double *x) {
+    return j0 (*x);
+}
+#endif
+
+#ifdef Ldbesj1
+doublereal dbesj1_ (const double *x) {
+    return j1 (*x);
+}
+#endif
+
+#ifdef Ldbesjn
+doublereal dbesjn_ (const integer *n, double *x) {
+    return jn (*n, *x);
+}
+#endif
+
+#ifdef Ldbesy0
+doublereal dbesy0_ (const double *x) {
+    return y0 (*x);
+}
+#endif
+
+#ifdef Ldbesy1
+doublereal dbesy1_ (const double *x) {
+    return y1 (*x);
+}
+#endif
+
+#ifdef Ldbesyn
+doublereal dbesyn_ (const integer *n, double *x) {
+    return yn (*n, *x);
+}
+#endif
+
+#ifdef Ldtime
+doublereal dtime_ (real tarray[2]) {
+    extern doublereal G77_dtime_0 (real tarray[2]);
+    return G77_dtime_0 (tarray);
+}
+#endif
+
+#ifdef Letime
+doublereal etime_ (real tarray[2]) {
+    extern doublereal G77_etime_0 (real tarray[2]);
+    return G77_etime_0 (tarray);
+}
+#endif
+
+#ifdef Lfdate
+void fdate_ (char *ret_val, ftnlen ret_val_len) {
+    extern void G77_fdate_0 (char *ret_val, ftnlen ret_val_len);
+    G77_fdate_0 (ret_val, ret_val_len);
+}
+#endif
+
+#ifdef Lfgetc
+integer fgetc_ (const integer *lunit, char *c, ftnlen Lc) {
+    extern integer G77_fgetc_0 (const integer *lunit, char *c, ftnlen Lc);
+    return G77_fgetc_0 (lunit, c, Lc);
+}
+#endif
+
+#ifdef Lfget
+integer fget_ (char *c, const ftnlen Lc) {
+    extern integer G77_fget_0 (char *c, const ftnlen Lc);
+    return G77_fget_0 (c, Lc);
+}
+#endif
+
+#ifdef Lflush1
+int flush1_ (const integer *lunit) {
+    extern int G77_flush1_0 (const integer *lunit);
+    return G77_flush1_0 (lunit);
+}
+#endif
+
+#ifdef Lfnum
+integer fnum_ (integer *lunit) {
+    extern integer G77_fnum_0 (integer *lunit);
+    return G77_fnum_0 (lunit);
+}
+#endif
+
+#ifdef Lfputc
+integer fputc_ (const integer *lunit, const char *c, const ftnlen Lc) {
+    extern integer G77_fputc_0 (const integer *lunit, const char *c, const ftnlen Lc);
+    return G77_fputc_0 (lunit, c, Lc);
+}
+#endif
+
+#ifdef Lfput
+integer fput_ (const char *c, const ftnlen Lc) {
+    extern integer G77_fput_0 (const char *c, const ftnlen Lc);
+    return G77_fput_0 (c, Lc);
+}
+#endif
+
+#ifdef Lfstat
+integer fstat_ (const integer *lunit, integer statb[13]) {
+    extern integer G77_fstat_0 (const integer *lunit, integer statb[13]);
+    return G77_fstat_0 (lunit, statb);
+}
+#endif
+
+#ifdef Lgerror
+int gerror_ (char *str, ftnlen Lstr) {
+    extern int G77_gerror_0 (char *str, ftnlen Lstr);
+    return G77_gerror_0 (str,  Lstr);
+}
+#endif
+
+#ifdef Lgetcwd
+integer getcwd_ (char *str, const ftnlen Lstr) {
+    extern integer G77_getcwd_0 (char *str, const ftnlen Lstr);
+    return G77_getcwd_0 (str, Lstr);
+}
+#endif
+
+#ifdef Lgetgid
+integer getgid_ (void) {
+    extern integer G77_getgid_0 (void);
+    return G77_getgid_0 ();
+}
+#endif
+
+#ifdef Lgetlog
+int getlog_ (char *str, const ftnlen Lstr) {
+    extern int G77_getlog_0 (char *str, const ftnlen Lstr);
+    return G77_getlog_0 (str, Lstr);
+}
+#endif
+
+#ifdef Lgetpid
+integer getpid_ (void) {
+    extern integer G77_getpid_0 (void);
+    return G77_getpid_0 ();
+}
+#endif
+
+#ifdef Lgetuid
+integer getuid_ (void) {
+    extern integer G77_getuid_0 (void);
+    return G77_getuid_0 ();
+}
+#endif
+
+#ifdef Lgmtime
+int gmtime_ (const integer *stime, integer tarray[9]) {
+    extern int G77_gmtime_0 (const integer *stime, integer tarray[9]);
+    return G77_gmtime_0 (stime, tarray);
+}
+#endif
+
+#ifdef Lhostnm
+integer hostnm_ (char *name, ftnlen Lname) {
+    extern integer G77_hostnm_0 (char *name, ftnlen Lname);
+    return G77_hostnm_0 (name, Lname);
+}
+#endif
+
+#ifdef Lidate
+int idate_ (int iarray[3]) {
+    extern int G77_idate_0 (int iarray[3]);
+    return G77_idate_0 (iarray);
+}
+#endif
+
+#ifdef Lierrno
+integer ierrno_ (void) {
+    extern integer G77_ierrno_0 (void);
+    return G77_ierrno_0 ();
+}
+#endif
+
+#ifdef Lirand
+integer irand_ (integer *flag) {
+    extern integer G77_irand_0 (integer *flag);
+    return G77_irand_0 (flag);
+}
+#endif
+
+#ifdef Lisatty
+logical isatty_ (integer *lunit) {
+    extern logical G77_isatty_0 (integer *lunit);
+    return G77_isatty_0 (lunit);
+}
+#endif
+
+#ifdef Litime
+int itime_ (integer tarray[3]) {
+    extern int G77_itime_0 (integer tarray[3]);
+    return G77_itime_0 (tarray);
+}
+#endif
+
+#ifdef Lkill
+integer kill_ (const integer *pid, const integer *signum) {
+    extern integer G77_kill_0 (const integer *pid, const integer *signum);
+    return G77_kill_0 (pid, signum);
+}
+#endif
+
+#ifdef Llink
+integer link_ (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) {
+    extern integer G77_link_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2);
+    return G77_link_0 (path1, path2, Lpath1, Lpath2);
+}
+#endif
+
+#ifdef Llnblnk
+integer lnblnk_ (char *str, ftnlen str_len) {
+    extern integer G77_lnblnk_0 (char *str, ftnlen str_len);
+    return G77_lnblnk_0 (str, str_len);
+}
+#endif
+
+#ifdef Llstat
+integer lstat_ (const char *name, integer statb[13], const ftnlen Lname) {
+    extern integer G77_lstat_0 (const char *name, integer statb[13], const ftnlen Lname);
+    return G77_lstat_0 (name, statb, Lname);
+}
+#endif
+
+#ifdef Lltime
+int ltime_ (const integer *stime, integer tarray[9]) {
+    extern int G77_ltime_0 (const integer *stime, integer tarray[9]);
+    return G77_ltime_0 (stime, tarray);
+}
+#endif
+
+#ifdef Lmclock
+longint mclock_ (void) {
+    extern longint G77_mclock_0 (void);
+    return G77_mclock_0 ();
+}
+#endif
+
+#ifdef Lperror
+int perror_ (const char *str, const ftnlen Lstr) {
+    extern int G77_perror_0 (const char *str, const ftnlen Lstr);
+    return G77_perror_0 (str, Lstr);
+}
+#endif
+
+#ifdef Lrand
+doublereal rand_ (integer *flag) {
+    extern doublereal G77_rand_0 (integer *flag);
+    return G77_rand_0 (flag);
+}
+#endif
+
+#ifdef Lrename
+integer rename_ (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) {
+    extern integer G77_rename_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2);
+    return G77_rename_0 (path1, path2, Lpath1, Lpath2);
+}
+#endif
+
+#ifdef Lsecnds
+doublereal secnds_ (real *r) {
+    extern doublereal G77_secnds_0 (real *r);
+    return G77_secnds_0 (r);
+}
+#endif
+
+#ifdef Lsecond
+doublereal second_ () {
+    extern doublereal G77_second_0 ();
+    return G77_second_0 ();
+}
+#endif
+
+#ifdef Lsleep
+int sleep_ (const integer *seconds) {
+    extern int G77_sleep_0 (const integer *seconds);
+    return G77_sleep_0 (seconds);
+}
+#endif
+
+#ifdef Lsrand
+int srand_ (const integer *seed) {
+    extern int G77_srand_0 (const integer *seed);
+    return G77_srand_0 (seed);
+}
+#endif
+
+#ifdef Lstat
+integer stat_ (const char *name, integer statb[13], const ftnlen Lname) {
+    extern integer G77_stat_0 (const char *name, integer statb[13], const ftnlen Lname);
+    return G77_stat_0 (name, statb, Lname);
+}
+#endif
+
+#ifdef Lsymlnk
+integer symlnk_ (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2) {
+    extern integer G77_symlnk_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2);
+    return G77_symlnk_0 (path1, path2, Lpath1, Lpath2);
+}
+#endif
+
+#ifdef Lsclock
+int system_clock_ (integer *count, integer *count_rate, integer *count_max) {
+    extern int G77_system_clock_0 (integer *count, integer *count_rate, integer *count_max);
+    return G77_system_clock_0 (count, count_rate, count_max);
+}
+#endif
+
+#ifdef Ltime
+longint time_ (void) {
+    extern longint G77_time_0 (void);
+    return G77_time_0 ();
+}
+#endif
+
+#ifdef Lttynam
+void ttynam_ (char *ret_val, ftnlen ret_val_len, integer *lunit) {
+    extern void G77_ttynam_0 (char *ret_val, ftnlen ret_val_len, integer *lunit);
+    G77_ttynam_0 (ret_val, ret_val_len, lunit);
+}
+#endif
+
+#ifdef Lumask
+integer umask_ (integer *mask) {
+    extern integer G77_umask_0 (integer *mask);
+    return G77_umask_0 (mask);
+}
+#endif
+
+#ifdef Lunlink
+integer unlink_ (const char *str, const ftnlen Lstr) {
+    extern integer G77_unlink_0 (const char *str, const ftnlen Lstr);
+    return G77_unlink_0 (str, Lstr);
+}
+#endif
+
+#ifdef Lvxtidt
+int vxtidate_ (integer *m, integer *d, integer *y) {
+    extern int G77_vxtidate_0 (integer *m, integer *d, integer *y);
+    return G77_vxtidate_0 (m, d, y);
+}
+#endif
+
+#ifdef Lvxttim
+void vxttime_ (char chtime[8], const ftnlen Lchtime) {
+    extern void G77_vxttime_0 (char chtime[8], const ftnlen Lchtime);
+    G77_vxttime_0 (chtime, Lchtime);
+}
+#endif
diff --git a/gcc/f/runtime/libF77/F77_aloc.c b/gcc/f/runtime/libF77/F77_aloc.c
new file mode 100644
index 00000000000..8754fe2ef70
--- /dev/null
+++ b/gcc/f/runtime/libF77/F77_aloc.c
@@ -0,0 +1,32 @@
+#include "f2c.h"
+#undef abs
+#undef min
+#undef max
+#include <stdio.h>
+
+static integer memfailure = 3;
+
+#ifdef KR_headers
+extern char *malloc();
+extern void G77_exit_0 ();
+
+ char *
+F77_aloc(Len, whence) integer Len; char *whence;
+#else
+#include <stdlib.h>
+extern void G77_exit_0 (integer*);
+
+ char *
+F77_aloc(integer Len, char *whence)
+#endif
+{
+	char *rv;
+	unsigned int uLen = (unsigned int) Len;	/* for K&R C */
+
+	if (!(rv = (char*)malloc(uLen))) {
+		fprintf(stderr, "malloc(%u) failure in %s\n",
+			uLen, whence);
+		G77_exit_0 (&memfailure);
+		}
+	return rv;
+	}
diff --git a/gcc/f/runtime/libF77/Makefile.in b/gcc/f/runtime/libF77/Makefile.in
new file mode 100644
index 00000000000..208626cb4a0
--- /dev/null
+++ b/gcc/f/runtime/libF77/Makefile.in
@@ -0,0 +1,95 @@
+# Makefile for GNU F77 compiler runtime.
+# Copyright 1990 - 1994 by AT&T Bell Laboratories and Bellcore (see the
+# file `Notice').
+#   Portions of this file Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+#   Contributed by Dave Love (d.love@dl.ac.uk).
+#
+#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.
+
+SHELL = /bin/sh
+
+srcdir = @srcdir@
+VPATH = @srcdir@
+
+#### Start of system configuration section. ####
+
+# The _FOR_TARGET things are appropriate for a cross-make, passed by the
+# superior makefile
+GCC_FOR_TARGET = @CC@
+CC = $(GCC_FOR_TARGET)
+CFLAGS = @CFLAGS@ $(GCC_FLAGS)
+CPPFLAGS = @CPPFLAGS@
+DEFS = @DEFS@
+CGFLAGS = -g0
+# f2c.h should already be installed in xgcc's include directory but add that
+# to -I anyhow in case not using xgcc.
+ALL_CFLAGS = -I. -I$(srcdir) -I../../../include $(CPPFLAGS) $(DEFS) $(CFLAGS)
+AR = @AR@
+AR_FLAGS = rc
+RANLIB = @RANLIB@
+RANLIB_TEST = @RANLIB_TEST@
+CROSS = @CROSS@
+
+.SUFFIXES:
+.SUFFIXES: .c .o
+
+.c.o:
+	$(CC) -c -DSkip_f2c_Undefs $(ALL_CFLAGS) $(CGFLAGS) $<
+
+MISC =	F77_aloc.o VersionF.o main.o s_rnge.o abort_.o getarg_.o iargc_.o\
+	getenv_.o signal_.o s_stop.o s_paus.o system_.o cabs.o\
+	derf_.o derfc_.o erf_.o erfc_.o sig_die.o exit_.o
+POW =	pow_ci.o pow_dd.o pow_di.o pow_hh.o pow_ii.o  pow_ri.o pow_zi.o pow_zz.o \
+	pow_qq.o
+CX =	c_abs.o c_cos.o c_div.o c_exp.o c_log.o c_sin.o c_sqrt.o
+DCX =	z_abs.o z_cos.o z_div.o z_exp.o z_log.o z_sin.o z_sqrt.o
+REAL =	r_abs.o r_acos.o r_asin.o r_atan.o r_atn2.o r_cnjg.o r_cos.o\
+	r_cosh.o r_dim.o r_exp.o r_imag.o r_int.o\
+	r_lg10.o r_log.o r_mod.o r_nint.o r_sign.o\
+	r_sin.o r_sinh.o r_sqrt.o r_tan.o r_tanh.o
+DBL =	d_abs.o d_acos.o d_asin.o d_atan.o d_atn2.o\
+	d_cnjg.o d_cos.o d_cosh.o d_dim.o d_exp.o\
+	d_imag.o d_int.o d_lg10.o d_log.o d_mod.o\
+	d_nint.o d_prod.o d_sign.o d_sin.o d_sinh.o\
+	d_sqrt.o d_tan.o d_tanh.o
+INT =	i_abs.o i_dim.o i_dnnt.o i_indx.o i_len.o i_mod.o i_nint.o i_sign.o
+HALF =	h_abs.o h_dim.o h_dnnt.o h_indx.o h_len.o h_mod.o  h_nint.o h_sign.o
+CMP =	l_ge.o l_gt.o l_le.o l_lt.o hl_ge.o hl_gt.o hl_le.o hl_lt.o
+EFL =	ef1asc_.o ef1cmc_.o
+CHAR =	s_cat.o s_cmp.o s_copy.o
+F90BIT = lbitbits.o lbitshft.o qbitbits.o qbitshft.o
+
+F2C_H = ../../../include/f2c.h
+
+all: $(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) \
+	 $(HALF) $(CMP) $(EFL) $(CHAR) $(F90BIT)
+
+VersionF.o: Version.c
+	$(CC) -c $(CGFLAGS) -o $@ $(srcdir)/Version.c
+
+mostlyclean clean:
+	-rm -f *.o
+
+distclean maintainer-clean: clean
+	-rm -f stage? include Makefile
+
+# Not quite all these actually do depend on f2c.h...
+$(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) \
+  $(HALF) $(CMP) $(EFL) $(CHAR) $(F90BIT): $(F2C_H)
+
+.PHONY: mostlyclean clean distclean maintainer-clean all
diff --git a/gcc/f/runtime/libF77/Notice b/gcc/f/runtime/libF77/Notice
new file mode 100644
index 00000000000..261b719bc57
--- /dev/null
+++ b/gcc/f/runtime/libF77/Notice
@@ -0,0 +1,23 @@
+/****************************************************************
+Copyright 1990 - 1997 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
diff --git a/gcc/f/runtime/libF77/README.netlib b/gcc/f/runtime/libF77/README.netlib
new file mode 100644
index 00000000000..76682152551
--- /dev/null
+++ b/gcc/f/runtime/libF77/README.netlib
@@ -0,0 +1,108 @@
+If your compiler does not recognize ANSI C headers,
+compile with KR_headers defined:  either add -DKR_headers
+to the definition of CFLAGS in the makefile, or insert
+
+#define KR_headers
+
+at the top of f2c.h , cabs.c , main.c , and sig_die.c .
+
+Under MS-DOS, compile s_paus.c with -DMSDOS.
+
+If you have a really ancient K&R C compiler that does not understand
+void, add -Dvoid=int to the definition of CFLAGS in the makefile.
+
+If you use a C++ compiler, first create a local f2c.h by appending
+f2ch.add to the usual f2c.h, e.g., by issuing the command
+	make f2c.h
+which assumes f2c.h is installed in /usr/include .
+
+If your system lacks onexit() and you are not using an ANSI C
+compiler, then you should compile main.c, s_paus.c, s_stop.c, and
+sig_die.c with NO_ONEXIT defined.  See the comments about onexit in
+the makefile.
+
+If your system has a double drem() function such that drem(a,b)
+is the IEEE remainder function (with double a, b), then you may
+wish to compile r_mod.c and d_mod.c with IEEE_drem defined.
+On some systems, you may also need to compile with -Ddrem=remainder .
+
+To check for transmission errors, issue the command
+	make check
+This assumes you have the xsum program whose source, xsum.c,
+is distributed as part of "all from f2c/src".  If you do not
+have xsum, you can obtain xsum.c by sending the following E-mail
+message to netlib@netlib.bell-labs.com
+	send xsum.c from f2c/src
+
+The makefile assumes you have installed f2c.h in a standard
+place (and does not cause recompilation when f2c.h is changed);
+f2c.h comes with "all from f2c" (the source for f2c) and is
+available separately ("f2c.h from f2c").
+
+Most of the routines in libF77 are support routines for Fortran
+intrinsic functions or for operations that f2c chooses not
+to do "in line".  There are a few exceptions, summarized below --
+functions and subroutines that appear to your program as ordinary
+external Fortran routines.
+
+1.	CALL ABORT prints a message and causes a core dump.
+
+2.	ERF(r) and DERF(d) and the REAL and DOUBLE PRECISION
+	error functions (with x REAL and d DOUBLE PRECISION);
+	DERF must be declared DOUBLE PRECISION in your program.
+	Both ERF and DERF assume your C library provides the
+	underlying erf() function (which not all systems do).
+
+3.	ERFC(r) and DERFC(d) are the complementary error functions:
+	ERFC(r) = 1 - ERF(r) and DERFC(d) = 1.d0 - DERFC(d)
+	(except that their results may be more accurate than
+	explicitly evaluating the above formulae would give).
+	Again, ERFC and r are REAL, and DERFC and d are DOUBLE
+	PRECISION (and must be declared as such in your program),
+	and ERFC and DERFC rely on your system's erfc().
+
+4.	CALL GETARG(n,s), where n is an INTEGER and s is a CHARACTER
+	variable, sets s to the n-th command-line argument (or to
+	all blanks if there are fewer than n command-line arguments);
+	CALL GETARG(0,s) sets s to the name of the program (on systems
+	that support this feature).  See IARGC below.
+
+5.	CALL GETENV(name, value), where name and value are of type
+	CHARACTER, sets value to the environment value, $name, of
+	name (or to blanks if $name has not been set).
+
+6.	NARGS = IARGC() sets NARGS to the number of command-line
+	arguments (an INTEGER value).
+
+7.	CALL SIGNAL(n,func), where n is an INTEGER and func is an
+	EXTERNAL procedure, arranges for func to be invoked when
+	signal n occurs (on systems where this makes sense).
+
+8.	CALL SYSTEM(cmd), where cmd is of type CHARACTER, passes
+	cmd to the system's command processor (on systems where
+	this can be done).
+
+The makefile does not attempt to compile pow_qq.c, qbitbits.c,
+and qbitshft.c, which are meant for use with INTEGER*8.  To use
+INTEGER*8, you must modify f2c.h to declare longint and ulongint
+appropriately; then add pow_qq.o to the POW = line in the makefile,
+and add " qbitbits.o qbitshft.o" to the makefile's F90BIT = line.
+
+Following Fortran 90, s_cat.c and s_copy.c allow the target of a
+(character string) assignment to be appear on its right-hand, at
+the cost of some extra overhead for all run-time concatenations.
+If you prefer the  extra efficiency that comes with the Fortran 77
+requirement that the left-hand side of a character assignment not
+be involved in the right-hand side, compile s_cat.c and s_copy.c
+with -DNO_OVERWRITE .
+
+If your system lacks a ranlib command, you don't need it.
+Either comment out the makefile's ranlib invocation, or install
+a harmless "ranlib" command somewhere in your PATH, such as the
+one-line shell script
+
+	exit 0
+
+or (on some systems)
+
+	exec /usr/bin/ar lts $1 >/dev/null
diff --git a/gcc/f/runtime/libF77/Version.c b/gcc/f/runtime/libF77/Version.c
new file mode 100644
index 00000000000..5d14f2a3f1d
--- /dev/null
+++ b/gcc/f/runtime/libF77/Version.c
@@ -0,0 +1,65 @@
+static char junk[] = "\n@(#)LIBF77 VERSION 19970404\n";
+
+/*
+*/
+
+char __G77_LIBF77_VERSION__[] = "0.5.21-19970811";
+
+/*
+2.00	11 June 1980.  File version.c added to library.
+2.01	31 May 1988.  s_paus() flushes stderr; names of hl_* fixed
+	[ d]erf[c ] added
+	 8 Aug. 1989: #ifdefs for f2c -i2 added to s_cat.c
+	29 Nov. 1989: s_cmp returns long (for f2c)
+	30 Nov. 1989: arg types from f2c.h
+	12 Dec. 1989: s_rnge allows long names
+	19 Dec. 1989: getenv_ allows unsorted environment
+	28 Mar. 1990: add exit(0) to end of main()
+	 2 Oct. 1990: test signal(...) == SIG_IGN rather than & 01 in main
+	17 Oct. 1990: abort() calls changed to sig_die(...,1)
+	22 Oct. 1990: separate sig_die from main
+	25 Apr. 1991: minor, theoretically invisible tweaks to s_cat, sig_die
+	31 May  1991: make system_ return status
+	18 Dec. 1991: change long to ftnlen (for -i2) many places
+	28 Feb. 1992: repair z_sqrt.c (scribbled on input, gave wrong answer)
+	18 July 1992: for n < 0, repair handling of 0**n in pow_[dr]i.c
+			and m**n in pow_hh.c and pow_ii.c;
+			catch SIGTRAP in main() for error msg before abort
+	23 July 1992: switch to ANSI prototypes unless KR_headers is #defined
+	23 Oct. 1992: fix botch in signal_.c (erroneous deref of 2nd arg);
+			change Cabs to f__cabs.
+	12 March 1993: various tweaks for C++
+	 2 June 1994: adjust so abnormal terminations invoke f_exit just once
+	16 Sept. 1994: s_cmp: treat characters as unsigned in comparisons.
+	19 Sept. 1994: s_paus: flush after end of PAUSE; add -DMSDOS
+	12 Jan. 1995:	pow_[dhiqrz][hiq]: adjust x**i to work on machines
+			that sign-extend right shifts when i is the most
+			negative integer.
+	26 Jan. 1995: adjust s_cat.c, s_copy.c to permit the left-hand side
+			of character assignments to appear on the right-hand
+			side (unless compiled with -DNO_OVERWRITE).
+	27 Jan. 1995: minor tweak to s_copy.c: copy forward whenever
+			possible (for better cache behavior).
+	30 May 1995:  added subroutine exit(rc) integer rc. Version not changed.
+	29 Aug. 1995: add F77_aloc.c; use it in s_cat.c and system_.c.
+	6 Sept. 1995: fix return type of system_ under -DKR_headers.
+	19 Dec. 1995: s_cat.c: fix bug when 2nd or later arg overlaps lhs.
+	19 Mar. 1996: s_cat.c: supply missing break after overlap detection.
+	13 May 1996:  add [lq]bitbits.c and [lq]bitshft.c (f90 bit intrinsics).
+	19 June 1996: add casts to unsigned in [lq]bitshft.c.
+	26 Feb. 1997: adjust functions with a complex output argument
+			to permit aliasing it with input arguments.
+			(For now, at least, this is just for possible
+			benefit of g77.)
+	4 April 1997: [cz]_div.c: tweaks invisible on most systems (that may
+			affect systems using gratuitous extra precision).
+*/
+
+#include <stdio.h>
+
+void
+g77__fvers__ ()
+{
+  fprintf (stderr, "__G77_LIBF77_VERSION__: %s", __G77_LIBF77_VERSION__);
+  fputs (junk, stderr);
+}
diff --git a/gcc/f/runtime/libF77/abort_.c b/gcc/f/runtime/libF77/abort_.c
new file mode 100644
index 00000000000..8efdc42f970
--- /dev/null
+++ b/gcc/f/runtime/libF77/abort_.c
@@ -0,0 +1,18 @@
+#include <stdio.h>
+#include "f2c.h"
+
+#ifdef KR_headers
+extern VOID sig_die();
+
+int G77_abort_0 ()
+#else
+extern void sig_die(char*,int);
+
+int G77_abort_0 (void)
+#endif
+{
+sig_die("Fortran abort routine called", 1);
+#ifdef __cplusplus
+return 0;
+#endif
+}
diff --git a/gcc/f/runtime/libF77/c_abs.c b/gcc/f/runtime/libF77/c_abs.c
new file mode 100644
index 00000000000..041fbd3d8bb
--- /dev/null
+++ b/gcc/f/runtime/libF77/c_abs.c
@@ -0,0 +1,14 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+extern double f__cabs();
+
+double c_abs(z) complex *z;
+#else
+extern double f__cabs(double, double);
+
+double c_abs(complex *z)
+#endif
+{
+return( f__cabs( z->r, z->i ) );
+}
diff --git a/gcc/f/runtime/libF77/c_cos.c b/gcc/f/runtime/libF77/c_cos.c
new file mode 100644
index 00000000000..9e833c168b3
--- /dev/null
+++ b/gcc/f/runtime/libF77/c_cos.c
@@ -0,0 +1,21 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+extern double sin(), cos(), sinh(), cosh();
+
+VOID c_cos(resx, z) complex *resx, *z;
+#else
+#undef abs
+#include <math.h>
+
+void c_cos(complex *resx, complex *z)
+#endif
+{
+complex res;
+
+res.r = cos(z->r) * cosh(z->i);
+res.i = - sin(z->r) * sinh(z->i);
+
+resx->r = res.r;
+resx->i = res.i;
+}
diff --git a/gcc/f/runtime/libF77/c_div.c b/gcc/f/runtime/libF77/c_div.c
new file mode 100644
index 00000000000..9568354bd53
--- /dev/null
+++ b/gcc/f/runtime/libF77/c_div.c
@@ -0,0 +1,40 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+extern VOID sig_die();
+VOID c_div(resx, a, b)
+complex *a, *b, *resx;
+#else
+extern void sig_die(char*,int);
+void c_div(complex *resx, complex *a, complex *b)
+#endif
+{
+double ratio, den;
+double abr, abi;
+complex res;
+
+if( (abr = b->r) < 0.)
+	abr = - abr;
+if( (abi = b->i) < 0.)
+	abi = - abi;
+if( abr <= abi )
+	{
+	if(abi == 0)
+		sig_die("complex division by zero", 1);
+	ratio = (double)b->r / b->i ;
+	den = b->i * (1 + ratio*ratio);
+	res.r = (a->r*ratio + a->i) / den;
+	res.i = (a->i*ratio - a->r) / den;
+	}
+
+else
+	{
+	ratio = (double)b->i / b->r ;
+	den = b->r * (1 + ratio*ratio);
+	res.r = (a->r + a->i*ratio) / den;
+	res.i = (a->i - a->r*ratio) / den;
+	}
+
+resx->r = res.r;
+resx->i = res.i;
+}
diff --git a/gcc/f/runtime/libF77/c_exp.c b/gcc/f/runtime/libF77/c_exp.c
new file mode 100644
index 00000000000..8d3d33d0fe3
--- /dev/null
+++ b/gcc/f/runtime/libF77/c_exp.c
@@ -0,0 +1,23 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+extern double exp(), cos(), sin();
+
+ VOID c_exp(resx, z) complex *resx, *z;
+#else
+#undef abs
+#include <math.h>
+
+void c_exp(complex *resx, complex *z)
+#endif
+{
+double expx;
+complex res;
+
+expx = exp(z->r);
+res.r = expx * cos(z->i);
+res.i = expx * sin(z->i);
+
+resx->r = res.r;
+resx->i = res.i;
+}
diff --git a/gcc/f/runtime/libF77/c_log.c b/gcc/f/runtime/libF77/c_log.c
new file mode 100644
index 00000000000..6715131ad1d
--- /dev/null
+++ b/gcc/f/runtime/libF77/c_log.c
@@ -0,0 +1,21 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+extern double log(), f__cabs(), atan2();
+VOID c_log(resx, z) complex *resx, *z;
+#else
+#undef abs
+#include <math.h>
+extern double f__cabs(double, double);
+
+void c_log(complex *resx, complex *z)
+#endif
+{
+complex res;
+
+res.i = atan2(z->i, z->r);
+res.r = log( f__cabs(z->r, z->i) );
+
+resx->r = res.r;
+resx->i = res.i;
+}
diff --git a/gcc/f/runtime/libF77/c_sin.c b/gcc/f/runtime/libF77/c_sin.c
new file mode 100644
index 00000000000..7bf3e392bed
--- /dev/null
+++ b/gcc/f/runtime/libF77/c_sin.c
@@ -0,0 +1,21 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+extern double sin(), cos(), sinh(), cosh();
+
+VOID c_sin(resx, z) complex *resx, *z;
+#else
+#undef abs
+#include <math.h>
+
+void c_sin(complex *resx, complex *z)
+#endif
+{
+complex res;
+
+res.r = sin(z->r) * cosh(z->i);
+res.i = cos(z->r) * sinh(z->i);
+
+resx->r = res.r;
+resx->i = res.i;
+}
diff --git a/gcc/f/runtime/libF77/c_sqrt.c b/gcc/f/runtime/libF77/c_sqrt.c
new file mode 100644
index 00000000000..775977a87f7
--- /dev/null
+++ b/gcc/f/runtime/libF77/c_sqrt.c
@@ -0,0 +1,38 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+extern double sqrt(), f__cabs();
+
+VOID c_sqrt(resx, z) complex *resx, *z;
+#else
+#undef abs
+#include <math.h>
+extern double f__cabs(double, double);
+
+void c_sqrt(complex *resx, complex *z)
+#endif
+{
+double mag, t;
+complex res;
+
+if( (mag = f__cabs(z->r, z->i)) == 0.)
+	res.r = res.i = 0.;
+else if(z->r > 0)
+	{
+	res.r = t = sqrt(0.5 * (mag + z->r) );
+	t = z->i / t;
+	res.i = 0.5 * t;
+	}
+else
+	{
+	t = sqrt(0.5 * (mag - z->r) );
+	if(z->i < 0)
+		t = -t;
+	res.i = t;
+	t = z->i / t;
+	res.r = 0.5 * t;
+	}
+
+resx->r = res.r;
+resx->i = res.i;
+}
diff --git a/gcc/f/runtime/libF77/cabs.c b/gcc/f/runtime/libF77/cabs.c
new file mode 100644
index 00000000000..2fad044e884
--- /dev/null
+++ b/gcc/f/runtime/libF77/cabs.c
@@ -0,0 +1,27 @@
+#ifdef KR_headers
+extern double sqrt();
+double f__cabs(real, imag) double real, imag;
+#else
+#undef abs
+#include <math.h>
+double f__cabs(double real, double imag)
+#endif
+{
+double temp;
+
+if(real < 0)
+	real = -real;
+if(imag < 0)
+	imag = -imag;
+if(imag > real){
+	temp = real;
+	real = imag;
+	imag = temp;
+}
+if((real+imag) == real)
+	return(real);
+
+temp = imag/real;
+temp = real*sqrt(1.0 + temp*temp);  /*overflow!!*/
+return(temp);
+}
diff --git a/gcc/f/runtime/libF77/d_abs.c b/gcc/f/runtime/libF77/d_abs.c
new file mode 100644
index 00000000000..cb157e067b7
--- /dev/null
+++ b/gcc/f/runtime/libF77/d_abs.c
@@ -0,0 +1,12 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double d_abs(x) doublereal *x;
+#else
+double d_abs(doublereal *x)
+#endif
+{
+if(*x >= 0)
+	return(*x);
+return(- *x);
+}
diff --git a/gcc/f/runtime/libF77/d_acos.c b/gcc/f/runtime/libF77/d_acos.c
new file mode 100644
index 00000000000..33da5369db2
--- /dev/null
+++ b/gcc/f/runtime/libF77/d_acos.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double acos();
+double d_acos(x) doublereal *x;
+#else
+#undef abs
+#include <math.h>
+double d_acos(doublereal *x)
+#endif
+{
+return( acos(*x) );
+}
diff --git a/gcc/f/runtime/libF77/d_asin.c b/gcc/f/runtime/libF77/d_asin.c
new file mode 100644
index 00000000000..79b33ca1bd6
--- /dev/null
+++ b/gcc/f/runtime/libF77/d_asin.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double asin();
+double d_asin(x) doublereal *x;
+#else
+#undef abs
+#include <math.h>
+double d_asin(doublereal *x)
+#endif
+{
+return( asin(*x) );
+}
diff --git a/gcc/f/runtime/libF77/d_atan.c b/gcc/f/runtime/libF77/d_atan.c
new file mode 100644
index 00000000000..caea4a406e0
--- /dev/null
+++ b/gcc/f/runtime/libF77/d_atan.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double atan();
+double d_atan(x) doublereal *x;
+#else
+#undef abs
+#include <math.h>
+double d_atan(doublereal *x)
+#endif
+{
+return( atan(*x) );
+}
diff --git a/gcc/f/runtime/libF77/d_atn2.c b/gcc/f/runtime/libF77/d_atn2.c
new file mode 100644
index 00000000000..6748a55d56f
--- /dev/null
+++ b/gcc/f/runtime/libF77/d_atn2.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double atan2();
+double d_atn2(x,y) doublereal *x, *y;
+#else
+#undef abs
+#include <math.h>
+double d_atn2(doublereal *x, doublereal *y)
+#endif
+{
+return( atan2(*x,*y) );
+}
diff --git a/gcc/f/runtime/libF77/d_cnjg.c b/gcc/f/runtime/libF77/d_cnjg.c
new file mode 100644
index 00000000000..1afa3bc4061
--- /dev/null
+++ b/gcc/f/runtime/libF77/d_cnjg.c
@@ -0,0 +1,17 @@
+#include "f2c.h"
+
+ VOID
+#ifdef KR_headers
+d_cnjg(resx, z) doublecomplex *resx, *z;
+#else
+d_cnjg(doublecomplex *resx, doublecomplex *z)
+#endif
+{
+doublecomplex res;
+
+res.r = z->r;
+res.i = - z->i;
+
+resx->r = res.r;
+resx->i = res.i;
+}
diff --git a/gcc/f/runtime/libF77/d_cos.c b/gcc/f/runtime/libF77/d_cos.c
new file mode 100644
index 00000000000..fa4d6ca406f
--- /dev/null
+++ b/gcc/f/runtime/libF77/d_cos.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double cos();
+double d_cos(x) doublereal *x;
+#else
+#undef abs
+#include <math.h>
+double d_cos(doublereal *x)
+#endif
+{
+return( cos(*x) );
+}
diff --git a/gcc/f/runtime/libF77/d_cosh.c b/gcc/f/runtime/libF77/d_cosh.c
new file mode 100644
index 00000000000..edc0ebc1092
--- /dev/null
+++ b/gcc/f/runtime/libF77/d_cosh.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double cosh();
+double d_cosh(x) doublereal *x;
+#else
+#undef abs
+#include <math.h>
+double d_cosh(doublereal *x)
+#endif
+{
+return( cosh(*x) );
+}
diff --git a/gcc/f/runtime/libF77/d_dim.c b/gcc/f/runtime/libF77/d_dim.c
new file mode 100644
index 00000000000..1d0ecb7bbb6
--- /dev/null
+++ b/gcc/f/runtime/libF77/d_dim.c
@@ -0,0 +1,10 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double d_dim(a,b) doublereal *a, *b;
+#else
+double d_dim(doublereal *a, doublereal *b)
+#endif
+{
+return( *a > *b ? *a - *b : 0);
+}
diff --git a/gcc/f/runtime/libF77/d_exp.c b/gcc/f/runtime/libF77/d_exp.c
new file mode 100644
index 00000000000..be12fd70551
--- /dev/null
+++ b/gcc/f/runtime/libF77/d_exp.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double exp();
+double d_exp(x) doublereal *x;
+#else
+#undef abs
+#include <math.h>
+double d_exp(doublereal *x)
+#endif
+{
+return( exp(*x) );
+}
diff --git a/gcc/f/runtime/libF77/d_imag.c b/gcc/f/runtime/libF77/d_imag.c
new file mode 100644
index 00000000000..793a3f9c405
--- /dev/null
+++ b/gcc/f/runtime/libF77/d_imag.c
@@ -0,0 +1,10 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double d_imag(z) doublecomplex *z;
+#else
+double d_imag(doublecomplex *z)
+#endif
+{
+return(z->i);
+}
diff --git a/gcc/f/runtime/libF77/d_int.c b/gcc/f/runtime/libF77/d_int.c
new file mode 100644
index 00000000000..beff1e7d378
--- /dev/null
+++ b/gcc/f/runtime/libF77/d_int.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double floor();
+double d_int(x) doublereal *x;
+#else
+#undef abs
+#include <math.h>
+double d_int(doublereal *x)
+#endif
+{
+return( (*x>0) ? floor(*x) : -floor(- *x) );
+}
diff --git a/gcc/f/runtime/libF77/d_lg10.c b/gcc/f/runtime/libF77/d_lg10.c
new file mode 100644
index 00000000000..c0892bd512a
--- /dev/null
+++ b/gcc/f/runtime/libF77/d_lg10.c
@@ -0,0 +1,15 @@
+#include "f2c.h"
+
+#define log10e 0.43429448190325182765
+
+#ifdef KR_headers
+double log();
+double d_lg10(x) doublereal *x;
+#else
+#undef abs
+#include <math.h>
+double d_lg10(doublereal *x)
+#endif
+{
+return( log10e * log(*x) );
+}
diff --git a/gcc/f/runtime/libF77/d_log.c b/gcc/f/runtime/libF77/d_log.c
new file mode 100644
index 00000000000..592015b2821
--- /dev/null
+++ b/gcc/f/runtime/libF77/d_log.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double log();
+double d_log(x) doublereal *x;
+#else
+#undef abs
+#include <math.h>
+double d_log(doublereal *x)
+#endif
+{
+return( log(*x) );
+}
diff --git a/gcc/f/runtime/libF77/d_mod.c b/gcc/f/runtime/libF77/d_mod.c
new file mode 100644
index 00000000000..23f19299168
--- /dev/null
+++ b/gcc/f/runtime/libF77/d_mod.c
@@ -0,0 +1,40 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+#ifdef IEEE_drem
+double drem();
+#else
+double floor();
+#endif
+double d_mod(x,y) doublereal *x, *y;
+#else
+#ifdef IEEE_drem
+double drem(double, double);
+#else
+#undef abs
+#include <math.h>
+#endif
+double d_mod(doublereal *x, doublereal *y)
+#endif
+{
+#ifdef IEEE_drem
+	double xa, ya, z;
+	if ((ya = *y) < 0.)
+		ya = -ya;
+	z = drem(xa = *x, ya);
+	if (xa > 0) {
+		if (z < 0)
+			z += ya;
+		}
+	else if (z > 0)
+		z -= ya;
+	return z;
+#else
+	double quotient;
+	if( (quotient = *x / *y) >= 0)
+		quotient = floor(quotient);
+	else
+		quotient = -floor(-quotient);
+	return(*x - (*y) * quotient );
+#endif
+}
diff --git a/gcc/f/runtime/libF77/d_nint.c b/gcc/f/runtime/libF77/d_nint.c
new file mode 100644
index 00000000000..064beff669c
--- /dev/null
+++ b/gcc/f/runtime/libF77/d_nint.c
@@ -0,0 +1,14 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double floor();
+double d_nint(x) doublereal *x;
+#else
+#undef abs
+#include <math.h>
+double d_nint(doublereal *x)
+#endif
+{
+return( (*x)>=0 ?
+	floor(*x + .5) : -floor(.5 - *x) );
+}
diff --git a/gcc/f/runtime/libF77/d_prod.c b/gcc/f/runtime/libF77/d_prod.c
new file mode 100644
index 00000000000..3d4cef7835c
--- /dev/null
+++ b/gcc/f/runtime/libF77/d_prod.c
@@ -0,0 +1,10 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double d_prod(x,y) real *x, *y;
+#else
+double d_prod(real *x, real *y)
+#endif
+{
+return( (*x) * (*y) );
+}
diff --git a/gcc/f/runtime/libF77/d_sign.c b/gcc/f/runtime/libF77/d_sign.c
new file mode 100644
index 00000000000..514ff0bbff8
--- /dev/null
+++ b/gcc/f/runtime/libF77/d_sign.c
@@ -0,0 +1,12 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double d_sign(a,b) doublereal *a, *b;
+#else
+double d_sign(doublereal *a, doublereal *b)
+#endif
+{
+double x;
+x = (*a >= 0 ? *a : - *a);
+return( *b >= 0 ? x : -x);
+}
diff --git a/gcc/f/runtime/libF77/d_sin.c b/gcc/f/runtime/libF77/d_sin.c
new file mode 100644
index 00000000000..fdd699eede5
--- /dev/null
+++ b/gcc/f/runtime/libF77/d_sin.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double sin();
+double d_sin(x) doublereal *x;
+#else
+#undef abs
+#include <math.h>
+double d_sin(doublereal *x)
+#endif
+{
+return( sin(*x) );
+}
diff --git a/gcc/f/runtime/libF77/d_sinh.c b/gcc/f/runtime/libF77/d_sinh.c
new file mode 100644
index 00000000000..77f36904f8e
--- /dev/null
+++ b/gcc/f/runtime/libF77/d_sinh.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double sinh();
+double d_sinh(x) doublereal *x;
+#else
+#undef abs
+#include <math.h>
+double d_sinh(doublereal *x)
+#endif
+{
+return( sinh(*x) );
+}
diff --git a/gcc/f/runtime/libF77/d_sqrt.c b/gcc/f/runtime/libF77/d_sqrt.c
new file mode 100644
index 00000000000..b5cf83b946f
--- /dev/null
+++ b/gcc/f/runtime/libF77/d_sqrt.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double sqrt();
+double d_sqrt(x) doublereal *x;
+#else
+#undef abs
+#include <math.h>
+double d_sqrt(doublereal *x)
+#endif
+{
+return( sqrt(*x) );
+}
diff --git a/gcc/f/runtime/libF77/d_tan.c b/gcc/f/runtime/libF77/d_tan.c
new file mode 100644
index 00000000000..af94a053223
--- /dev/null
+++ b/gcc/f/runtime/libF77/d_tan.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double tan();
+double d_tan(x) doublereal *x;
+#else
+#undef abs
+#include <math.h>
+double d_tan(doublereal *x)
+#endif
+{
+return( tan(*x) );
+}
diff --git a/gcc/f/runtime/libF77/d_tanh.c b/gcc/f/runtime/libF77/d_tanh.c
new file mode 100644
index 00000000000..92a02d4fd6b
--- /dev/null
+++ b/gcc/f/runtime/libF77/d_tanh.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double tanh();
+double d_tanh(x) doublereal *x;
+#else
+#undef abs
+#include <math.h>
+double d_tanh(doublereal *x)
+#endif
+{
+return( tanh(*x) );
+}
diff --git a/gcc/f/runtime/libF77/derf_.c b/gcc/f/runtime/libF77/derf_.c
new file mode 100644
index 00000000000..fba6b6b11f3
--- /dev/null
+++ b/gcc/f/runtime/libF77/derf_.c
@@ -0,0 +1,12 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double erf();
+double G77_derf_0 (x) doublereal *x;
+#else
+extern double erf(double);
+double G77_derf_0 (doublereal *x)
+#endif
+{
+return( erf(*x) );
+}
diff --git a/gcc/f/runtime/libF77/derfc_.c b/gcc/f/runtime/libF77/derfc_.c
new file mode 100644
index 00000000000..ae1ac740302
--- /dev/null
+++ b/gcc/f/runtime/libF77/derfc_.c
@@ -0,0 +1,14 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+extern double erfc();
+
+double G77_derfc_0 (x) doublereal *x;
+#else
+extern double erfc(double);
+
+double G77_derfc_0 (doublereal *x)
+#endif
+{
+return( erfc(*x) );
+}
diff --git a/gcc/f/runtime/libF77/dtime_.c b/gcc/f/runtime/libF77/dtime_.c
new file mode 100644
index 00000000000..2e775c6b84e
--- /dev/null
+++ b/gcc/f/runtime/libF77/dtime_.c
@@ -0,0 +1,45 @@
+#include "time.h"
+#ifndef USE_CLOCK
+#include "sys/types.h"
+#include "sys/times.h"
+#endif
+
+#undef Hz
+#ifdef CLK_TCK
+#define Hz CLK_TCK
+#else
+#ifdef HZ
+#define Hz HZ
+#else
+#define Hz 60
+#endif
+#endif
+
+ float
+#ifdef KR_headers
+dtime_(tarray) float *tarray;
+#else
+dtime_(float *tarray)
+#endif
+{
+#ifdef USE_CLOCK
+#ifndef CLOCKS_PER_SECOND
+#define CLOCKS_PER_SECOND Hz
+#endif
+	static double t0;
+	double t = clock();
+	tarray[1] = 0;
+	tarray[0] = (t - t0) / CLOCKS_PER_SECOND;
+	t0 = t;
+	return tarray[0];
+#else
+	struct tms t;
+	static struct tms t0;
+
+	times(&t);
+	tarray[0] = (t.tms_utime - t0.tms_utime) / Hz;
+	tarray[1] = (t.tms_stime - t0.tms_stime) / Hz;
+	t0 = t;
+	return tarray[0] + tarray[1];
+#endif
+	}
diff --git a/gcc/f/runtime/libF77/ef1asc_.c b/gcc/f/runtime/libF77/ef1asc_.c
new file mode 100644
index 00000000000..a922a1d9ba9
--- /dev/null
+++ b/gcc/f/runtime/libF77/ef1asc_.c
@@ -0,0 +1,21 @@
+/* EFL support routine to copy string b to string a */
+
+#include "f2c.h"
+
+
+#define M	( (long) (sizeof(long) - 1) )
+#define EVEN(x)	( ( (x)+ M) & (~M) )
+
+#ifdef KR_headers
+extern VOID s_copy();
+G77_ef1asc_0 (a, la, b, lb) ftnint *a, *b; ftnlen *la, *lb;
+#else
+extern void s_copy(char*,char*,ftnlen,ftnlen);
+int G77_ef1asc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb)
+#endif
+{
+s_copy( (char *)a, (char *)b, EVEN(*la), *lb );
+#ifdef __cplusplus
+return 0;
+#endif
+}
diff --git a/gcc/f/runtime/libF77/ef1cmc_.c b/gcc/f/runtime/libF77/ef1cmc_.c
new file mode 100644
index 00000000000..f471172935f
--- /dev/null
+++ b/gcc/f/runtime/libF77/ef1cmc_.c
@@ -0,0 +1,14 @@
+/* EFL support routine to compare two character strings */
+
+#include "f2c.h"
+
+#ifdef KR_headers
+extern integer s_cmp();
+integer G77_ef1cmc_0 (a, la, b, lb) ftnint *a, *b; ftnlen *la, *lb;
+#else
+extern integer s_cmp(char*,char*,ftnlen,ftnlen);
+integer G77_ef1cmc_0 (ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb)
+#endif
+{
+return( s_cmp( (char *)a, (char *)b, *la, *lb) );
+}
diff --git a/gcc/f/runtime/libF77/erf_.c b/gcc/f/runtime/libF77/erf_.c
new file mode 100644
index 00000000000..1ba4350ad05
--- /dev/null
+++ b/gcc/f/runtime/libF77/erf_.c
@@ -0,0 +1,12 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double erf();
+double G77_erf_0 (x) real *x;
+#else
+extern double erf(double);
+double G77_erf_0 (real *x)
+#endif
+{
+return( erf(*x) );
+}
diff --git a/gcc/f/runtime/libF77/erfc_.c b/gcc/f/runtime/libF77/erfc_.c
new file mode 100644
index 00000000000..f44b1d49d84
--- /dev/null
+++ b/gcc/f/runtime/libF77/erfc_.c
@@ -0,0 +1,12 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double erfc();
+double G77_erfc_0 (x) real *x;
+#else
+extern double erfc(double);
+double G77_erfc_0 (real *x)
+#endif
+{
+return( erfc(*x) );
+}
diff --git a/gcc/f/runtime/libF77/etime_.c b/gcc/f/runtime/libF77/etime_.c
new file mode 100644
index 00000000000..0fb658af43c
--- /dev/null
+++ b/gcc/f/runtime/libF77/etime_.c
@@ -0,0 +1,38 @@
+#include "time.h"
+#ifndef USE_CLOCK
+#include "sys/types.h"
+#include "sys/times.h"
+#endif
+
+#undef Hz
+#ifdef CLK_TCK
+#define Hz CLK_TCK
+#else
+#ifdef HZ
+#define Hz HZ
+#else
+#define Hz 60
+#endif
+#endif
+
+ float
+#ifdef KR_headers
+etime_(tarray) float *tarray;
+#else
+etime_(float *tarray)
+#endif
+{
+#ifdef USE_CLOCK
+#ifndef CLOCKS_PER_SECOND
+#define CLOCKS_PER_SECOND Hz
+#endif
+	double t = clock();
+	tarray[1] = 0;
+	return tarray[0] = t / CLOCKS_PER_SECOND;
+#else
+	struct tms t;
+
+	times(&t);
+	return (tarray[0] = t.tms_utime/Hz) + (tarray[1] = t.tms_stime/Hz);
+#endif
+	}
diff --git a/gcc/f/runtime/libF77/exit_.c b/gcc/f/runtime/libF77/exit_.c
new file mode 100644
index 00000000000..4c0582add12
--- /dev/null
+++ b/gcc/f/runtime/libF77/exit_.c
@@ -0,0 +1,37 @@
+/* This gives the effect of
+
+	subroutine exit(rc)
+	integer*4 rc
+	stop
+	end
+
+ * with the added side effect of supplying rc as the program's exit code.
+ */
+
+#include "f2c.h"
+#undef abs
+#undef min
+#undef max
+#ifndef KR_headers
+#include <stdlib.h>
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern void f_exit(void);
+#endif
+
+ void
+#ifdef KR_headers
+G77_exit_0 (rc) integer *rc;
+#else
+G77_exit_0 (integer *rc)
+#endif
+{
+#ifdef NO_ONEXIT
+	f_exit();
+#endif
+	exit(*rc);
+	}
+#ifdef __cplusplus
+}
+#endif
diff --git a/gcc/f/runtime/libF77/f2ch.add b/gcc/f/runtime/libF77/f2ch.add
new file mode 100644
index 00000000000..a2acc17a159
--- /dev/null
+++ b/gcc/f/runtime/libF77/f2ch.add
@@ -0,0 +1,162 @@
+/* If you are using a C++ compiler, append the following to f2c.h
+   for compiling libF77 and libI77. */
+
+#ifdef __cplusplus
+extern "C" {
+extern int abort_(void);
+extern double c_abs(complex *);
+extern void c_cos(complex *, complex *);
+extern void c_div(complex *, complex *, complex *);
+extern void c_exp(complex *, complex *);
+extern void c_log(complex *, complex *);
+extern void c_sin(complex *, complex *);
+extern void c_sqrt(complex *, complex *);
+extern double d_abs(double *);
+extern double d_acos(double *);
+extern double d_asin(double *);
+extern double d_atan(double *);
+extern double d_atn2(double *, double *);
+extern void d_cnjg(doublecomplex *, doublecomplex *);
+extern double d_cos(double *);
+extern double d_cosh(double *);
+extern double d_dim(double *, double *);
+extern double d_exp(double *);
+extern double d_imag(doublecomplex *);
+extern double d_int(double *);
+extern double d_lg10(double *);
+extern double d_log(double *);
+extern double d_mod(double *, double *);
+extern double d_nint(double *);
+extern double d_prod(float *, float *);
+extern double d_sign(double *, double *);
+extern double d_sin(double *);
+extern double d_sinh(double *);
+extern double d_sqrt(double *);
+extern double d_tan(double *);
+extern double d_tanh(double *);
+extern double derf_(double *);
+extern double derfc_(double *);
+extern integer do_fio(ftnint *, char *, ftnlen);
+extern integer do_lio(ftnint *, ftnint *, char *, ftnlen);
+extern integer do_uio(ftnint *, char *, ftnlen);
+extern integer e_rdfe(void);
+extern integer e_rdue(void);
+extern integer e_rsfe(void);
+extern integer e_rsfi(void);
+extern integer e_rsle(void);
+extern integer e_rsli(void);
+extern integer e_rsue(void);
+extern integer e_wdfe(void);
+extern integer e_wdue(void);
+extern integer e_wsfe(void);
+extern integer e_wsfi(void);
+extern integer e_wsle(void);
+extern integer e_wsli(void);
+extern integer e_wsue(void);
+extern int ef1asc_(ftnint *, ftnlen *, ftnint *, ftnlen *);
+extern integer ef1cmc_(ftnint *, ftnlen *, ftnint *, ftnlen *);
+extern double erf(double);
+extern double erf_(float *);
+extern double erfc(double);
+extern double erfc_(float *);
+extern integer f_back(alist *);
+extern integer f_clos(cllist *);
+extern integer f_end(alist *);
+extern void f_exit(void);
+extern integer f_inqu(inlist *);
+extern integer f_open(olist *);
+extern integer f_rew(alist *);
+extern int flush_(void);
+extern void getarg_(integer *, char *, ftnlen);
+extern void getenv_(char *, char *, ftnlen, ftnlen);
+extern short h_abs(short *);
+extern short h_dim(short *, short *);
+extern short h_dnnt(double *);
+extern short h_indx(char *, char *, ftnlen, ftnlen);
+extern short h_len(char *, ftnlen);
+extern short h_mod(short *, short *);
+extern short h_nint(float *);
+extern short h_sign(short *, short *);
+extern short hl_ge(char *, char *, ftnlen, ftnlen);
+extern short hl_gt(char *, char *, ftnlen, ftnlen);
+extern short hl_le(char *, char *, ftnlen, ftnlen);
+extern short hl_lt(char *, char *, ftnlen, ftnlen);
+extern integer i_abs(integer *);
+extern integer i_dim(integer *, integer *);
+extern integer i_dnnt(double *);
+extern integer i_indx(char *, char *, ftnlen, ftnlen);
+extern integer i_len(char *, ftnlen);
+extern integer i_mod(integer *, integer *);
+extern integer i_nint(float *);
+extern integer i_sign(integer *, integer *);
+extern integer iargc_(void);
+extern ftnlen l_ge(char *, char *, ftnlen, ftnlen);
+extern ftnlen l_gt(char *, char *, ftnlen, ftnlen);
+extern ftnlen l_le(char *, char *, ftnlen, ftnlen);
+extern ftnlen l_lt(char *, char *, ftnlen, ftnlen);
+extern void pow_ci(complex *, complex *, integer *);
+extern double pow_dd(double *, double *);
+extern double pow_di(double *, integer *);
+extern short pow_hh(short *, shortint *);
+extern integer pow_ii(integer *, integer *);
+extern double pow_ri(float *, integer *);
+extern void pow_zi(doublecomplex *, doublecomplex *, integer *);
+extern void pow_zz(doublecomplex *, doublecomplex *, doublecomplex *);
+extern double r_abs(float *);
+extern double r_acos(float *);
+extern double r_asin(float *);
+extern double r_atan(float *);
+extern double r_atn2(float *, float *);
+extern void r_cnjg(complex *, complex *);
+extern double r_cos(float *);
+extern double r_cosh(float *);
+extern double r_dim(float *, float *);
+extern double r_exp(float *);
+extern double r_imag(complex *);
+extern double r_int(float *);
+extern double r_lg10(float *);
+extern double r_log(float *);
+extern double r_mod(float *, float *);
+extern double r_nint(float *);
+extern double r_sign(float *, float *);
+extern double r_sin(float *);
+extern double r_sinh(float *);
+extern double r_sqrt(float *);
+extern double r_tan(float *);
+extern double r_tanh(float *);
+extern void s_cat(char *, char **, integer *, integer *, ftnlen);
+extern integer s_cmp(char *, char *, ftnlen, ftnlen);
+extern void s_copy(char *, char *, ftnlen, ftnlen);
+extern int s_paus(char *, ftnlen);
+extern integer s_rdfe(cilist *);
+extern integer s_rdue(cilist *);
+extern integer s_rnge(char *, integer, char *, integer);
+extern integer s_rsfe(cilist *);
+extern integer s_rsfi(icilist *);
+extern integer s_rsle(cilist *);
+extern integer s_rsli(icilist *);
+extern integer s_rsne(cilist *);
+extern integer s_rsni(icilist *);
+extern integer s_rsue(cilist *);
+extern int s_stop(char *, ftnlen);
+extern integer s_wdfe(cilist *);
+extern integer s_wdue(cilist *);
+extern integer s_wsfe(cilist *);
+extern integer s_wsfi(icilist *);
+extern integer s_wsle(cilist *);
+extern integer s_wsli(icilist *);
+extern integer s_wsne(cilist *);
+extern integer s_wsni(icilist *);
+extern integer s_wsue(cilist *);
+extern void sig_die(char *, int);
+extern integer signal_(integer *, void (*)(int));
+extern integer system_(char *, ftnlen);
+extern double z_abs(doublecomplex *);
+extern void z_cos(doublecomplex *, doublecomplex *);
+extern void z_div(doublecomplex *, doublecomplex *, doublecomplex *);
+extern void z_exp(doublecomplex *, doublecomplex *);
+extern void z_log(doublecomplex *, doublecomplex *);
+extern void z_sin(doublecomplex *, doublecomplex *);
+extern void z_sqrt(doublecomplex *, doublecomplex *);
+	}
+#endif
diff --git a/gcc/f/runtime/libF77/getarg_.c b/gcc/f/runtime/libF77/getarg_.c
new file mode 100644
index 00000000000..eaded2e4c9b
--- /dev/null
+++ b/gcc/f/runtime/libF77/getarg_.c
@@ -0,0 +1,28 @@
+#include "f2c.h"
+
+/*
+ * subroutine getarg(k, c)
+ * returns the kth unix command argument in fortran character
+ * variable argument c
+*/
+
+#ifdef KR_headers
+VOID G77_getarg_0 (n, s, ls) ftnint *n; register char *s; ftnlen ls;
+#else
+void G77_getarg_0 (ftnint *n, register char *s, ftnlen ls)
+#endif
+{
+extern int xargc;
+extern char **xargv;
+register char *t;
+register int i;
+
+if(*n>=0 && *n<xargc)
+	t = xargv[*n];
+else
+	t = "";
+for(i = 0; i<ls && *t!='\0' ; ++i)
+	*s++ = *t++;
+for( ; i<ls ; ++i)
+	*s++ = ' ';
+}
diff --git a/gcc/f/runtime/libF77/getenv_.c b/gcc/f/runtime/libF77/getenv_.c
new file mode 100644
index 00000000000..b9916e6065e
--- /dev/null
+++ b/gcc/f/runtime/libF77/getenv_.c
@@ -0,0 +1,51 @@
+#include "f2c.h"
+
+/*
+ * getenv - f77 subroutine to return environment variables
+ *
+ * called by:
+ *	call getenv (ENV_NAME, char_var)
+ * where:
+ *	ENV_NAME is the name of an environment variable
+ *	char_var is a character variable which will receive
+ *		the current value of ENV_NAME, or all blanks
+ *		if ENV_NAME is not defined
+ */
+
+#ifdef KR_headers
+VOID G77_getenv_0 (fname, value, flen, vlen) char *value, *fname; ftnlen vlen, flen;
+#else
+void G77_getenv_0 (char *fname, char *value, ftnlen flen, ftnlen vlen)
+#endif
+{
+extern char **environ;
+register char *ep, *fp, *flast;
+register char **env = environ;
+
+flast = fname + flen;
+for(fp = fname ; fp < flast ; ++fp)
+	if(*fp == ' ')
+		{
+		flast = fp;
+		break;
+		}
+
+while (ep = *env++)
+	{
+	for(fp = fname; fp<flast ; )
+		if(*fp++ != *ep++)
+			goto endloop;
+
+	if(*ep++ == '=') {	/* copy right hand side */
+		while( *ep && --vlen>=0 )
+			*value++ = *ep++;
+
+		goto blank;
+		}
+endloop: ;
+	}
+
+blank:
+	while( --vlen >= 0 )
+		*value++ = ' ';
+}
diff --git a/gcc/f/runtime/libF77/h_abs.c b/gcc/f/runtime/libF77/h_abs.c
new file mode 100644
index 00000000000..73b82151ac1
--- /dev/null
+++ b/gcc/f/runtime/libF77/h_abs.c
@@ -0,0 +1,12 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+shortint h_abs(x) shortint *x;
+#else
+shortint h_abs(shortint *x)
+#endif
+{
+if(*x >= 0)
+	return(*x);
+return(- *x);
+}
diff --git a/gcc/f/runtime/libF77/h_dim.c b/gcc/f/runtime/libF77/h_dim.c
new file mode 100644
index 00000000000..ceff660e26c
--- /dev/null
+++ b/gcc/f/runtime/libF77/h_dim.c
@@ -0,0 +1,10 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+shortint h_dim(a,b) shortint *a, *b;
+#else
+shortint h_dim(shortint *a, shortint *b)
+#endif
+{
+return( *a > *b ? *a - *b : 0);
+}
diff --git a/gcc/f/runtime/libF77/h_dnnt.c b/gcc/f/runtime/libF77/h_dnnt.c
new file mode 100644
index 00000000000..9d0aa25f1d3
--- /dev/null
+++ b/gcc/f/runtime/libF77/h_dnnt.c
@@ -0,0 +1,14 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double floor();
+shortint h_dnnt(x) doublereal *x;
+#else
+#undef abs
+#include <math.h>
+shortint h_dnnt(doublereal *x)
+#endif
+{
+return( (*x)>=0 ?
+	floor(*x + .5) : -floor(.5 - *x) );
+}
diff --git a/gcc/f/runtime/libF77/h_indx.c b/gcc/f/runtime/libF77/h_indx.c
new file mode 100644
index 00000000000..a211cc7fa0f
--- /dev/null
+++ b/gcc/f/runtime/libF77/h_indx.c
@@ -0,0 +1,26 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+shortint h_indx(a, b, la, lb) char *a, *b; ftnlen la, lb;
+#else
+shortint h_indx(char *a, char *b, ftnlen la, ftnlen lb)
+#endif
+{
+ftnlen i, n;
+char *s, *t, *bend;
+
+n = la - lb + 1;
+bend = b + lb;
+
+for(i = 0 ; i < n ; ++i)
+	{
+	s = a + i;
+	t = b;
+	while(t < bend)
+		if(*s++ != *t++)
+			goto no;
+	return((shortint)i+1);
+	no: ;
+	}
+return(0);
+}
diff --git a/gcc/f/runtime/libF77/h_len.c b/gcc/f/runtime/libF77/h_len.c
new file mode 100644
index 00000000000..00a2151bfa1
--- /dev/null
+++ b/gcc/f/runtime/libF77/h_len.c
@@ -0,0 +1,10 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+shortint h_len(s, n) char *s; ftnlen n;
+#else
+shortint h_len(char *s, ftnlen n)
+#endif
+{
+return(n);
+}
diff --git a/gcc/f/runtime/libF77/h_mod.c b/gcc/f/runtime/libF77/h_mod.c
new file mode 100644
index 00000000000..43431c1c503
--- /dev/null
+++ b/gcc/f/runtime/libF77/h_mod.c
@@ -0,0 +1,10 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+shortint h_mod(a,b) short *a, *b;
+#else
+shortint h_mod(short *a, short *b)
+#endif
+{
+return( *a % *b);
+}
diff --git a/gcc/f/runtime/libF77/h_nint.c b/gcc/f/runtime/libF77/h_nint.c
new file mode 100644
index 00000000000..0af3735da42
--- /dev/null
+++ b/gcc/f/runtime/libF77/h_nint.c
@@ -0,0 +1,14 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double floor();
+shortint h_nint(x) real *x;
+#else
+#undef abs
+#include <math.h>
+shortint h_nint(real *x)
+#endif
+{
+return( (*x)>=0 ?
+	floor(*x + .5) : -floor(.5 - *x) );
+}
diff --git a/gcc/f/runtime/libF77/h_sign.c b/gcc/f/runtime/libF77/h_sign.c
new file mode 100644
index 00000000000..7b06c157a74
--- /dev/null
+++ b/gcc/f/runtime/libF77/h_sign.c
@@ -0,0 +1,12 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+shortint h_sign(a,b) shortint *a, *b;
+#else
+shortint h_sign(shortint *a, shortint *b)
+#endif
+{
+shortint x;
+x = (*a >= 0 ? *a : - *a);
+return( *b >= 0 ? x : -x);
+}
diff --git a/gcc/f/runtime/libF77/hl_ge.c b/gcc/f/runtime/libF77/hl_ge.c
new file mode 100644
index 00000000000..4c29527065a
--- /dev/null
+++ b/gcc/f/runtime/libF77/hl_ge.c
@@ -0,0 +1,12 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+extern integer s_cmp();
+shortlogical hl_ge(a,b,la,lb) char *a, *b; ftnlen la, lb;
+#else
+extern integer s_cmp(char *, char *, ftnlen, ftnlen);
+shortlogical hl_ge(char *a, char *b, ftnlen la, ftnlen lb)
+#endif
+{
+return(s_cmp(a,b,la,lb) >= 0);
+}
diff --git a/gcc/f/runtime/libF77/hl_gt.c b/gcc/f/runtime/libF77/hl_gt.c
new file mode 100644
index 00000000000..c4f345a0859
--- /dev/null
+++ b/gcc/f/runtime/libF77/hl_gt.c
@@ -0,0 +1,12 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+extern integer s_cmp();
+shortlogical hl_gt(a,b,la,lb) char *a, *b; ftnlen la, lb;
+#else
+extern integer s_cmp(char *, char *, ftnlen, ftnlen);
+shortlogical hl_gt(char *a, char *b, ftnlen la, ftnlen lb)
+#endif
+{
+return(s_cmp(a,b,la,lb) > 0);
+}
diff --git a/gcc/f/runtime/libF77/hl_le.c b/gcc/f/runtime/libF77/hl_le.c
new file mode 100644
index 00000000000..a9cce596c71
--- /dev/null
+++ b/gcc/f/runtime/libF77/hl_le.c
@@ -0,0 +1,12 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+extern integer s_cmp();
+shortlogical hl_le(a,b,la,lb) char *a, *b; ftnlen la, lb;
+#else
+extern integer s_cmp(char *, char *, ftnlen, ftnlen);
+shortlogical hl_le(char *a, char *b, ftnlen la, ftnlen lb)
+#endif
+{
+return(s_cmp(a,b,la,lb) <= 0);
+}
diff --git a/gcc/f/runtime/libF77/hl_lt.c b/gcc/f/runtime/libF77/hl_lt.c
new file mode 100644
index 00000000000..162d919c3b4
--- /dev/null
+++ b/gcc/f/runtime/libF77/hl_lt.c
@@ -0,0 +1,12 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+extern integer s_cmp();
+shortlogical hl_lt(a,b,la,lb) char *a, *b; ftnlen la, lb;
+#else
+extern integer s_cmp(char *, char *, ftnlen, ftnlen);
+shortlogical hl_lt(char *a, char *b, ftnlen la, ftnlen lb)
+#endif
+{
+return(s_cmp(a,b,la,lb) < 0);
+}
diff --git a/gcc/f/runtime/libF77/i_abs.c b/gcc/f/runtime/libF77/i_abs.c
new file mode 100644
index 00000000000..be21295aaa1
--- /dev/null
+++ b/gcc/f/runtime/libF77/i_abs.c
@@ -0,0 +1,12 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+integer i_abs(x) integer *x;
+#else
+integer i_abs(integer *x)
+#endif
+{
+if(*x >= 0)
+	return(*x);
+return(- *x);
+}
diff --git a/gcc/f/runtime/libF77/i_dim.c b/gcc/f/runtime/libF77/i_dim.c
new file mode 100644
index 00000000000..6e1b1707b55
--- /dev/null
+++ b/gcc/f/runtime/libF77/i_dim.c
@@ -0,0 +1,10 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+integer i_dim(a,b) integer *a, *b;
+#else
+integer i_dim(integer *a, integer *b)
+#endif
+{
+return( *a > *b ? *a - *b : 0);
+}
diff --git a/gcc/f/runtime/libF77/i_dnnt.c b/gcc/f/runtime/libF77/i_dnnt.c
new file mode 100644
index 00000000000..8fcecb68200
--- /dev/null
+++ b/gcc/f/runtime/libF77/i_dnnt.c
@@ -0,0 +1,14 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double floor();
+integer i_dnnt(x) doublereal *x;
+#else
+#undef abs
+#include <math.h>
+integer i_dnnt(doublereal *x)
+#endif
+{
+return( (*x)>=0 ?
+	floor(*x + .5) : -floor(.5 - *x) );
+}
diff --git a/gcc/f/runtime/libF77/i_indx.c b/gcc/f/runtime/libF77/i_indx.c
new file mode 100644
index 00000000000..96e7bc51ba8
--- /dev/null
+++ b/gcc/f/runtime/libF77/i_indx.c
@@ -0,0 +1,26 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+integer i_indx(a, b, la, lb) char *a, *b; ftnlen la, lb;
+#else
+integer i_indx(char *a, char *b, ftnlen la, ftnlen lb)
+#endif
+{
+ftnlen i, n;
+char *s, *t, *bend;
+
+n = la - lb + 1;
+bend = b + lb;
+
+for(i = 0 ; i < n ; ++i)
+	{
+	s = a + i;
+	t = b;
+	while(t < bend)
+		if(*s++ != *t++)
+			goto no;
+	return(i+1);
+	no: ;
+	}
+return(0);
+}
diff --git a/gcc/f/runtime/libF77/i_len.c b/gcc/f/runtime/libF77/i_len.c
new file mode 100644
index 00000000000..4020fee4618
--- /dev/null
+++ b/gcc/f/runtime/libF77/i_len.c
@@ -0,0 +1,10 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+integer i_len(s, n) char *s; ftnlen n;
+#else
+integer i_len(char *s, ftnlen n)
+#endif
+{
+return(n);
+}
diff --git a/gcc/f/runtime/libF77/i_mod.c b/gcc/f/runtime/libF77/i_mod.c
new file mode 100644
index 00000000000..6937c421357
--- /dev/null
+++ b/gcc/f/runtime/libF77/i_mod.c
@@ -0,0 +1,10 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+integer i_mod(a,b) integer *a, *b;
+#else
+integer i_mod(integer *a, integer *b)
+#endif
+{
+return( *a % *b);
+}
diff --git a/gcc/f/runtime/libF77/i_nint.c b/gcc/f/runtime/libF77/i_nint.c
new file mode 100644
index 00000000000..c0f6795171f
--- /dev/null
+++ b/gcc/f/runtime/libF77/i_nint.c
@@ -0,0 +1,14 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double floor();
+integer i_nint(x) real *x;
+#else
+#undef abs
+#include <math.h>
+integer i_nint(real *x)
+#endif
+{
+return( (*x)>=0 ?
+	floor(*x + .5) : -floor(.5 - *x) );
+}
diff --git a/gcc/f/runtime/libF77/i_sign.c b/gcc/f/runtime/libF77/i_sign.c
new file mode 100644
index 00000000000..94009b86e6f
--- /dev/null
+++ b/gcc/f/runtime/libF77/i_sign.c
@@ -0,0 +1,12 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+integer i_sign(a,b) integer *a, *b;
+#else
+integer i_sign(integer *a, integer *b)
+#endif
+{
+integer x;
+x = (*a >= 0 ? *a : - *a);
+return( *b >= 0 ? x : -x);
+}
diff --git a/gcc/f/runtime/libF77/iargc_.c b/gcc/f/runtime/libF77/iargc_.c
new file mode 100644
index 00000000000..7ce5e08d306
--- /dev/null
+++ b/gcc/f/runtime/libF77/iargc_.c
@@ -0,0 +1,11 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+ftnint G77_iargc_0 ()
+#else
+ftnint G77_iargc_0 (void)
+#endif
+{
+extern int xargc;
+return ( xargc - 1 );
+}
diff --git a/gcc/f/runtime/libF77/l_ge.c b/gcc/f/runtime/libF77/l_ge.c
new file mode 100644
index 00000000000..86b4a1f5a7f
--- /dev/null
+++ b/gcc/f/runtime/libF77/l_ge.c
@@ -0,0 +1,12 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+extern integer s_cmp();
+logical l_ge(a,b,la,lb) char *a, *b; ftnlen la, lb;
+#else
+extern integer s_cmp(char *, char *, ftnlen, ftnlen);
+logical l_ge(char *a, char *b, ftnlen la, ftnlen lb)
+#endif
+{
+return(s_cmp(a,b,la,lb) >= 0);
+}
diff --git a/gcc/f/runtime/libF77/l_gt.c b/gcc/f/runtime/libF77/l_gt.c
new file mode 100644
index 00000000000..c4b52f5bf7d
--- /dev/null
+++ b/gcc/f/runtime/libF77/l_gt.c
@@ -0,0 +1,12 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+extern integer s_cmp();
+logical l_gt(a,b,la,lb) char *a, *b; ftnlen la, lb;
+#else
+extern integer s_cmp(char *, char *, ftnlen, ftnlen);
+logical l_gt(char *a, char *b, ftnlen la, ftnlen lb)
+#endif
+{
+return(s_cmp(a,b,la,lb) > 0);
+}
diff --git a/gcc/f/runtime/libF77/l_le.c b/gcc/f/runtime/libF77/l_le.c
new file mode 100644
index 00000000000..f2740a23814
--- /dev/null
+++ b/gcc/f/runtime/libF77/l_le.c
@@ -0,0 +1,12 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+extern integer s_cmp();
+logical l_le(a,b,la,lb) char *a, *b; ftnlen la, lb;
+#else
+extern integer s_cmp(char *, char *, ftnlen, ftnlen);
+logical l_le(char *a, char *b, ftnlen la, ftnlen lb)
+#endif
+{
+return(s_cmp(a,b,la,lb) <= 0);
+}
diff --git a/gcc/f/runtime/libF77/l_lt.c b/gcc/f/runtime/libF77/l_lt.c
new file mode 100644
index 00000000000..c48dc946f9a
--- /dev/null
+++ b/gcc/f/runtime/libF77/l_lt.c
@@ -0,0 +1,12 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+extern integer s_cmp();
+logical l_lt(a,b,la,lb) char *a, *b; ftnlen la, lb;
+#else
+extern integer s_cmp(char *, char *, ftnlen, ftnlen);
+logical l_lt(char *a, char *b, ftnlen la, ftnlen lb)
+#endif
+{
+return(s_cmp(a,b,la,lb) < 0);
+}
diff --git a/gcc/f/runtime/libF77/lbitbits.c b/gcc/f/runtime/libF77/lbitbits.c
new file mode 100644
index 00000000000..75e9f9c603f
--- /dev/null
+++ b/gcc/f/runtime/libF77/lbitbits.c
@@ -0,0 +1,62 @@
+#include "f2c.h"
+
+#ifndef LONGBITS
+#define LONGBITS 32
+#endif
+
+ integer
+#ifdef KR_headers
+lbit_bits(a, b, len) integer a, b, len;
+#else
+lbit_bits(integer a, integer b, integer len)
+#endif
+{
+	/* Assume 2's complement arithmetic */
+
+	unsigned long x, y;
+
+	x = (unsigned long) a;
+	y = (unsigned long)-1L;
+	x >>= b;
+	y <<= len;
+	return (integer)(x & ~y);
+	}
+
+ integer
+#ifdef KR_headers
+lbit_cshift(a, b, len) integer a, b, len;
+#else
+lbit_cshift(integer a, integer b, integer len)
+#endif
+{
+	unsigned long x, y, z;
+
+	x = (unsigned long)a;
+	if (len <= 0) {
+		if (len == 0)
+			return 0;
+		goto full_len;
+		}
+	if (len >= LONGBITS) {
+ full_len:
+		if (b >= 0) {
+			b %= LONGBITS;
+			return (integer)(x << b | x >> LONGBITS -b );
+			}
+		b = -b;
+		b %= LONGBITS;
+		return (integer)(x << LONGBITS - b | x >> b);
+		}
+	y = z = (unsigned long)-1;
+	y <<= len;
+	z &= ~y;
+	y &= x;
+	x &= z;
+	if (b >= 0) {
+		b %= len;
+		return (integer)(y | z & (x << b | x >> len - b));
+		}
+	b = -b;
+	b %= len;
+	return (integer)(y | z & (x >> b | x << len - b));
+	}
diff --git a/gcc/f/runtime/libF77/lbitshft.c b/gcc/f/runtime/libF77/lbitshft.c
new file mode 100644
index 00000000000..81b0fdbeaba
--- /dev/null
+++ b/gcc/f/runtime/libF77/lbitshft.c
@@ -0,0 +1,11 @@
+#include "f2c.h"
+
+ integer
+#ifdef KR_headers
+lbit_shift(a, b) integer a; integer b;
+#else
+lbit_shift(integer a, integer b)
+#endif
+{
+	return b >= 0 ? a << b : (integer)((uinteger)a >> -b);
+	}
diff --git a/gcc/f/runtime/libF77/main.c b/gcc/f/runtime/libF77/main.c
new file mode 100644
index 00000000000..469a64bdcb3
--- /dev/null
+++ b/gcc/f/runtime/libF77/main.c
@@ -0,0 +1,135 @@
+/* STARTUP PROCEDURE FOR UNIX FORTRAN PROGRAMS */
+
+#include <stdio.h>
+#include "signal1.h"
+
+#ifndef SIGIOT
+#ifdef SIGABRT
+#define SIGIOT SIGABRT
+#endif
+#endif
+
+#ifndef KR_headers
+#undef VOID
+#include <stdlib.h>
+#endif
+
+#ifndef VOID
+#define VOID void
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifdef NO__STDC
+#define ONEXIT onexit
+extern VOID f_exit();
+#else
+#ifndef KR_headers
+extern void f_exit(void);
+#ifndef NO_ONEXIT
+#define ONEXIT atexit
+extern int atexit(void (*)(void));
+#endif
+#else
+#ifndef NO_ONEXIT
+#define ONEXIT onexit
+extern VOID f_exit();
+#endif
+#endif
+#endif
+
+#ifdef KR_headers
+extern VOID f_init(), sig_die();
+extern int MAIN__();
+#define Int /* int */
+#else
+extern void f_init(void), sig_die(char*, int);
+extern int MAIN__(void);
+#define Int int
+#endif
+
+static VOID sigfdie(Int n)
+{
+sig_die("Floating Exception", 1);
+}
+
+
+static VOID sigidie(Int n)
+{
+sig_die("IOT Trap", 1);
+}
+
+#ifdef SIGQUIT
+static VOID sigqdie(Int n)
+{
+sig_die("Quit signal", 1);
+}
+#endif
+
+
+static VOID sigindie(Int n)
+{
+sig_die("Interrupt", 0);
+}
+
+static VOID sigtdie(Int n)
+{
+sig_die("Killed", 0);
+}
+
+#ifdef SIGTRAP
+static VOID sigtrdie(Int n)
+{
+sig_die("Trace trap", 1);
+}
+#endif
+
+
+int xargc;
+char **xargv;
+
+#ifdef __cplusplus
+	}
+#endif
+
+#ifdef KR_headers
+main(argc, argv) int argc; char **argv;
+#else
+main(int argc, char **argv)
+#endif
+{
+xargc = argc;
+xargv = argv;
+signal1(SIGFPE, sigfdie);	/* ignore underflow, enable overflow */
+#ifdef SIGIOT
+signal1(SIGIOT, sigidie);
+#endif
+#ifdef SIGTRAP
+signal1(SIGTRAP, sigtrdie);
+#endif
+#ifdef SIGQUIT
+if(signal1(SIGQUIT,sigqdie) == SIG_IGN)
+	signal1(SIGQUIT, SIG_IGN);
+#endif
+if(signal1(SIGINT, sigindie) == SIG_IGN)
+	signal1(SIGINT, SIG_IGN);
+signal1(SIGTERM,sigtdie);
+
+#ifdef pdp11
+	ldfps(01200); /* detect overflow as an exception */
+#endif
+
+f_init();
+#ifndef NO_ONEXIT
+ONEXIT(f_exit);
+#endif
+MAIN__();
+#ifdef NO_ONEXIT
+f_exit();
+#endif
+exit(0);	/* exit(0) rather than return(0) to bypass Cray bug */
+return 0;	/* For compilers that complain of missing return values; */
+		/* others will complain that this is unreachable code. */
+}
diff --git a/gcc/f/runtime/libF77/makefile.netlib b/gcc/f/runtime/libF77/makefile.netlib
new file mode 100644
index 00000000000..230ca7e9f93
--- /dev/null
+++ b/gcc/f/runtime/libF77/makefile.netlib
@@ -0,0 +1,103 @@
+.SUFFIXES: .c .o
+CC = cc
+SHELL = /bin/sh
+CFLAGS = -O
+
+# If your system lacks onexit() and you are not using an
+# ANSI C compiler, then you should add -DNO_ONEXIT to CFLAGS,
+# e.g., by changing the above "CFLAGS =" line to
+# CFLAGS = -O -DNO_ONEXIT
+
+# On at least some Sun systems, it is more appropriate to change the
+# "CFLAGS =" line to
+# CFLAGS = -O -Donexit=on_exit
+
+# compile, then strip unnecessary symbols
+.c.o:
+	$(CC) -c -DSkip_f2c_Undefs $(CFLAGS) $*.c
+	ld -r -x -o $*.xxx $*.o
+	mv $*.xxx $*.o
+## Under Solaris (and other systems that do not understand ld -x),
+## omit -x in the ld line above.
+## If your system does not have the ld command, comment out
+## or remove both the ld and mv lines above.
+
+MISC =	F77_aloc.o Version.o main.o s_rnge.o abort_.o getarg_.o iargc_.o \
+	getenv_.o signal_.o s_stop.o s_paus.o system_.o cabs.o\
+	derf_.o derfc_.o erf_.o erfc_.o sig_die.o exit_.o
+POW =	pow_ci.o pow_dd.o pow_di.o pow_hh.o pow_ii.o  pow_ri.o pow_zi.o pow_zz.o
+CX =	c_abs.o c_cos.o c_div.o c_exp.o c_log.o c_sin.o c_sqrt.o
+DCX =	z_abs.o z_cos.o z_div.o z_exp.o z_log.o z_sin.o z_sqrt.o
+REAL =	r_abs.o r_acos.o r_asin.o r_atan.o r_atn2.o r_cnjg.o r_cos.o\
+	r_cosh.o r_dim.o r_exp.o r_imag.o r_int.o\
+	r_lg10.o r_log.o r_mod.o r_nint.o r_sign.o\
+	r_sin.o r_sinh.o r_sqrt.o r_tan.o r_tanh.o
+DBL =	d_abs.o d_acos.o d_asin.o d_atan.o d_atn2.o\
+	d_cnjg.o d_cos.o d_cosh.o d_dim.o d_exp.o\
+	d_imag.o d_int.o d_lg10.o d_log.o d_mod.o\
+	d_nint.o d_prod.o d_sign.o d_sin.o d_sinh.o\
+	d_sqrt.o d_tan.o d_tanh.o
+INT =	i_abs.o i_dim.o i_dnnt.o i_indx.o i_len.o i_mod.o i_nint.o i_sign.o
+HALF =	h_abs.o h_dim.o h_dnnt.o h_indx.o h_len.o h_mod.o  h_nint.o h_sign.o
+CMP =	l_ge.o l_gt.o l_le.o l_lt.o hl_ge.o hl_gt.o hl_le.o hl_lt.o
+EFL =	ef1asc_.o ef1cmc_.o
+CHAR =	F77_aloc.o s_cat.o s_cmp.o s_copy.o
+F90BIT = lbitbits.o lbitshft.o
+QINT =	pow_qq.o qbitbits.o qbitshft.o
+TIME =	dtime_.o etime_.o
+
+all: signal1.h libF77.a
+
+# You may need to adjust signal1.h suitably for your system...
+signal1.h: signal1.h0
+	cp signal1.h0 signal1.h
+
+# If you get an error compiling dtime_.c or etime_.c, try adding
+# -DUSE_CLOCK to the CFLAGS assignment above; if that does not work,
+# omit $(TIME) from the dependency list for libF77.a below.
+
+# For INTEGER*8 support (which requires system-dependent adjustments to
+# f2c.h), add $(QINT) to the libf2c.a dependency list below...
+
+libF77.a : $(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) \
+	$(HALF) $(CMP) $(EFL) $(CHAR) $(F90BIT) $(TIME)
+	ar r libF77.a $?
+	-ranlib libF77.a
+
+### If your system lacks ranlib, you don't need it; see README.
+
+Version.o: Version.c
+	$(CC) -c Version.c
+
+# To compile with C++, first "make f2c.h"
+f2c.h: f2ch.add
+	cat /usr/include/f2c.h f2ch.add >f2c.h
+
+install:	libF77.a
+	mv libF77.a /usr/lib
+	ranlib /usr/lib/libF77.a
+
+clean:
+	rm -f libF77.a *.o
+
+check:
+	xsum F77_aloc.c Notice README Version.c abort_.c c_abs.c c_cos.c \
+	c_div.c c_exp.c c_log.c c_sin.c c_sqrt.c cabs.c d_abs.c d_acos.c \
+	d_asin.c d_atan.c d_atn2.c d_cnjg.c d_cos.c d_cosh.c d_dim.c \
+	d_exp.c d_imag.c d_int.c d_lg10.c d_log.c d_mod.c d_nint.c \
+	d_prod.c d_sign.c d_sin.c d_sinh.c d_sqrt.c d_tan.c d_tanh.c \
+	derf_.c derfc_.c dtime_.c \
+	ef1asc_.c ef1cmc_.c erf_.c erfc_.c etime_.c exit_.c f2ch.add \
+	getarg_.c getenv_.c h_abs.c h_dim.c h_dnnt.c h_indx.c h_len.c \
+	h_mod.c h_nint.c h_sign.c hl_ge.c hl_gt.c hl_le.c hl_lt.c \
+	i_abs.c i_dim.c i_dnnt.c i_indx.c i_len.c i_mod.c i_nint.c \
+	i_sign.c iargc_.c l_ge.c l_gt.c l_le.c l_lt.c lbitbits.c lbitshft.c \
+	main.c makefile pow_ci.c pow_dd.c pow_di.c pow_hh.c pow_ii.c \
+	pow_qq.c pow_ri.c pow_zi.c pow_zz.c qbitbits.c qbitshft.c \
+	r_abs.c r_acos.c r_asin.c r_atan.c r_atn2.c \
+	r_cnjg.c r_cos.c r_cosh.c r_dim.c r_exp.c r_imag.c r_int.c r_lg10.c \
+	r_log.c r_mod.c r_nint.c r_sign.c r_sin.c r_sinh.c r_sqrt.c \
+	r_tan.c r_tanh.c s_cat.c s_cmp.c s_copy.c \
+	s_paus.c s_rnge.c s_stop.c sig_die.c signal1.h0 signal_.c system_.c \
+	z_abs.c z_cos.c z_div.c z_exp.c z_log.c z_sin.c z_sqrt.c >zap
+	cmp zap libF77.xsum && rm zap || diff libF77.xsum zap
diff --git a/gcc/f/runtime/libF77/pow_ci.c b/gcc/f/runtime/libF77/pow_ci.c
new file mode 100644
index 00000000000..37e2ce0f2eb
--- /dev/null
+++ b/gcc/f/runtime/libF77/pow_ci.c
@@ -0,0 +1,20 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+VOID pow_ci(p, a, b) 	/* p = a**b  */
+ complex *p, *a; integer *b;
+#else
+extern void pow_zi(doublecomplex*, doublecomplex*, integer*);
+void pow_ci(complex *p, complex *a, integer *b) 	/* p = a**b  */
+#endif
+{
+doublecomplex p1, a1;
+
+a1.r = a->r;
+a1.i = a->i;
+
+pow_zi(&p1, &a1, b);
+
+p->r = p1.r;
+p->i = p1.i;
+}
diff --git a/gcc/f/runtime/libF77/pow_dd.c b/gcc/f/runtime/libF77/pow_dd.c
new file mode 100644
index 00000000000..d0dd0ff2744
--- /dev/null
+++ b/gcc/f/runtime/libF77/pow_dd.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double pow();
+double pow_dd(ap, bp) doublereal *ap, *bp;
+#else
+#undef abs
+#include <math.h>
+double pow_dd(doublereal *ap, doublereal *bp)
+#endif
+{
+return(pow(*ap, *bp) );
+}
diff --git a/gcc/f/runtime/libF77/pow_di.c b/gcc/f/runtime/libF77/pow_di.c
new file mode 100644
index 00000000000..affed625a91
--- /dev/null
+++ b/gcc/f/runtime/libF77/pow_di.c
@@ -0,0 +1,35 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double pow_di(ap, bp) doublereal *ap; integer *bp;
+#else
+double pow_di(doublereal *ap, integer *bp)
+#endif
+{
+double pow, x;
+integer n;
+unsigned long u;
+
+pow = 1;
+x = *ap;
+n = *bp;
+
+if(n != 0)
+	{
+	if(n < 0)
+		{
+		n = -n;
+		x = 1/x;
+		}
+	for(u = n; ; )
+		{
+		if(u & 01)
+			pow *= x;
+		if(u >>= 1)
+			x *= x;
+		else
+			break;
+		}
+	}
+return(pow);
+}
diff --git a/gcc/f/runtime/libF77/pow_hh.c b/gcc/f/runtime/libF77/pow_hh.c
new file mode 100644
index 00000000000..24a019734da
--- /dev/null
+++ b/gcc/f/runtime/libF77/pow_hh.c
@@ -0,0 +1,33 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+shortint pow_hh(ap, bp) shortint *ap, *bp;
+#else
+shortint pow_hh(shortint *ap, shortint *bp)
+#endif
+{
+	shortint pow, x, n;
+	unsigned u;
+
+	x = *ap;
+	n = *bp;
+
+	if (n <= 0) {
+		if (n == 0 || x == 1)
+			return 1;
+		if (x != -1)
+			return x == 0 ? 1/x : 0;
+		n = -n;
+		}
+	u = n;
+	for(pow = 1; ; )
+		{
+		if(u & 01)
+			pow *= x;
+		if(u >>= 1)
+			x *= x;
+		else
+			break;
+		}
+	return(pow);
+	}
diff --git a/gcc/f/runtime/libF77/pow_ii.c b/gcc/f/runtime/libF77/pow_ii.c
new file mode 100644
index 00000000000..84d1c7e0b5e
--- /dev/null
+++ b/gcc/f/runtime/libF77/pow_ii.c
@@ -0,0 +1,33 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+integer pow_ii(ap, bp) integer *ap, *bp;
+#else
+integer pow_ii(integer *ap, integer *bp)
+#endif
+{
+	integer pow, x, n;
+	unsigned long u;
+
+	x = *ap;
+	n = *bp;
+
+	if (n <= 0) {
+		if (n == 0 || x == 1)
+			return 1;
+		if (x != -1)
+			return x == 0 ? 1/x : 0;
+		n = -n;
+		}
+	u = n;
+	for(pow = 1; ; )
+		{
+		if(u & 01)
+			pow *= x;
+		if(u >>= 1)
+			x *= x;
+		else
+			break;
+		}
+	return(pow);
+	}
diff --git a/gcc/f/runtime/libF77/pow_qq.c b/gcc/f/runtime/libF77/pow_qq.c
new file mode 100644
index 00000000000..3bc80e05f7f
--- /dev/null
+++ b/gcc/f/runtime/libF77/pow_qq.c
@@ -0,0 +1,33 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+longint pow_qq(ap, bp) longint *ap, *bp;
+#else
+longint pow_qq(longint *ap, longint *bp)
+#endif
+{
+	longint pow, x, n;
+	unsigned long long u;	/* system-dependent */
+
+	x = *ap;
+	n = *bp;
+
+	if (n <= 0) {
+		if (n == 0 || x == 1)
+			return 1;
+		if (x != -1)
+			return x == 0 ? 1/x : 0;
+		n = -n;
+		}
+	u = n;
+	for(pow = 1; ; )
+		{
+		if(u & 01)
+			pow *= x;
+		if(u >>= 1)
+			x *= x;
+		else
+			break;
+		}
+	return(pow);
+	}
diff --git a/gcc/f/runtime/libF77/pow_ri.c b/gcc/f/runtime/libF77/pow_ri.c
new file mode 100644
index 00000000000..6e5816bbf10
--- /dev/null
+++ b/gcc/f/runtime/libF77/pow_ri.c
@@ -0,0 +1,35 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double pow_ri(ap, bp) real *ap; integer *bp;
+#else
+double pow_ri(real *ap, integer *bp)
+#endif
+{
+double pow, x;
+integer n;
+unsigned long u;
+
+pow = 1;
+x = *ap;
+n = *bp;
+
+if(n != 0)
+	{
+	if(n < 0)
+		{
+		n = -n;
+		x = 1/x;
+		}
+	for(u = n; ; )
+		{
+		if(u & 01)
+			pow *= x;
+		if(u >>= 1)
+			x *= x;
+		else
+			break;
+		}
+	}
+return(pow);
+}
diff --git a/gcc/f/runtime/libF77/pow_zi.c b/gcc/f/runtime/libF77/pow_zi.c
new file mode 100644
index 00000000000..898ea6be917
--- /dev/null
+++ b/gcc/f/runtime/libF77/pow_zi.c
@@ -0,0 +1,61 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+VOID pow_zi(resx, a, b) 	/* p = a**b  */
+ doublecomplex *resx, *a; integer *b;
+#else
+extern void z_div(doublecomplex*, doublecomplex*, doublecomplex*);
+void pow_zi(doublecomplex *resx, doublecomplex *a, integer *b) 	/* p = a**b  */
+#endif
+{
+integer n;
+unsigned long u;
+double t;
+doublecomplex x;
+doublecomplex res;
+static doublecomplex one = {1.0, 0.0};
+
+n = *b;
+
+if(n == 0)
+	{
+	resx->r = 1;
+	resx->i = 0;
+	return;
+	}
+
+res.r = 1;
+res.i = 0;
+
+if(n < 0)
+	{
+	n = -n;
+	z_div(&x, &one, a);
+	}
+else
+	{
+	x.r = a->r;
+	x.i = a->i;
+	}
+
+for(u = n; ; )
+	{
+	if(u & 01)
+		{
+		t = res.r * x.r - res.i * x.i;
+		res.i = res.r * x.i + res.i * x.r;
+		res.r = t;
+		}
+	if(u >>= 1)
+		{
+		t = x.r * x.r - x.i * x.i;
+		x.i = 2 * x.r * x.i;
+		x.r = t;
+		}
+	else
+		break;
+	}
+
+resx->r = res.r;
+resx->i = res.i;
+}
diff --git a/gcc/f/runtime/libF77/pow_zz.c b/gcc/f/runtime/libF77/pow_zz.c
new file mode 100644
index 00000000000..20faf29cfb8
--- /dev/null
+++ b/gcc/f/runtime/libF77/pow_zz.c
@@ -0,0 +1,23 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double log(), exp(), cos(), sin(), atan2(), f__cabs();
+VOID pow_zz(r,a,b) doublecomplex *r, *a, *b;
+#else
+#undef abs
+#include <math.h>
+extern double f__cabs(double,double);
+void pow_zz(doublecomplex *r, doublecomplex *a, doublecomplex *b)
+#endif
+{
+double logr, logi, x, y;
+
+logr = log( f__cabs(a->r, a->i) );
+logi = atan2(a->i, a->r);
+
+x = exp( logr * b->r - logi * b->i );
+y = logr * b->i + logi * b->r;
+
+r->r = x * cos(y);
+r->i = x * sin(y);
+}
diff --git a/gcc/f/runtime/libF77/qbitbits.c b/gcc/f/runtime/libF77/qbitbits.c
new file mode 100644
index 00000000000..ad4ac963ce2
--- /dev/null
+++ b/gcc/f/runtime/libF77/qbitbits.c
@@ -0,0 +1,66 @@
+#include "f2c.h"
+
+#ifndef LONGBITS
+#define LONGBITS 32
+#endif
+
+#ifndef LONG8BITS
+#define LONG8BITS (2*LONGBITS)
+#endif
+
+ integer
+#ifdef KR_headers
+qbit_bits(a, b, len) longint a; integer b, len;
+#else
+qbit_bits(longint a, integer b, integer len)
+#endif
+{
+	/* Assume 2's complement arithmetic */
+
+	ulongint x, y;
+
+	x = (ulongint) a;
+	y = (ulongint)-1L;
+	x >>= b;
+	y <<= len;
+	return (longint)(x & y);
+	}
+
+ longint
+#ifdef KR_headers
+qbit_cshift(a, b, len) longint a; integer b, len;
+#else
+qbit_cshift(longint a, integer b, integer len)
+#endif
+{
+	ulongint x, y, z;
+
+	x = (ulongint)a;
+	if (len <= 0) {
+		if (len == 0)
+			return 0;
+		goto full_len;
+		}
+	if (len >= LONG8BITS) {
+ full_len:
+		if (b >= 0) {
+			b %= LONG8BITS;
+			return (longint)(x << b | x >> LONG8BITS - b );
+			}
+		b = -b;
+		b %= LONG8BITS;
+		return (longint)(x << LONG8BITS - b | x >> b);
+		}
+	y = z = (unsigned long)-1;
+	y <<= len;
+	z &= ~y;
+	y &= x;
+	x &= z;
+	if (b >= 0) {
+		b %= len;
+		return (longint)(y | z & (x << b | x >> len - b));
+		}
+	b = -b;
+	b %= len;
+	return (longint)(y | z & (x >> b | x << len - b));
+	}
diff --git a/gcc/f/runtime/libF77/qbitshft.c b/gcc/f/runtime/libF77/qbitshft.c
new file mode 100644
index 00000000000..87fffb91ff8
--- /dev/null
+++ b/gcc/f/runtime/libF77/qbitshft.c
@@ -0,0 +1,11 @@
+#include "f2c.h"
+
+ longint
+#ifdef KR_headers
+qbit_shift(a, b) longint a; integer b;
+#else
+qbit_shift(longint a, integer b)
+#endif
+{
+	return b >= 0 ? a << b : (longint)((ulongint)a >> -b);
+	}
diff --git a/gcc/f/runtime/libF77/r_abs.c b/gcc/f/runtime/libF77/r_abs.c
new file mode 100644
index 00000000000..7b222961d16
--- /dev/null
+++ b/gcc/f/runtime/libF77/r_abs.c
@@ -0,0 +1,12 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double r_abs(x) real *x;
+#else
+double r_abs(real *x)
+#endif
+{
+if(*x >= 0)
+	return(*x);
+return(- *x);
+}
diff --git a/gcc/f/runtime/libF77/r_acos.c b/gcc/f/runtime/libF77/r_acos.c
new file mode 100644
index 00000000000..330f88a3092
--- /dev/null
+++ b/gcc/f/runtime/libF77/r_acos.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double acos();
+double r_acos(x) real *x;
+#else
+#undef abs
+#include <math.h>
+double r_acos(real *x)
+#endif
+{
+return( acos(*x) );
+}
diff --git a/gcc/f/runtime/libF77/r_asin.c b/gcc/f/runtime/libF77/r_asin.c
new file mode 100644
index 00000000000..45ece4b749e
--- /dev/null
+++ b/gcc/f/runtime/libF77/r_asin.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double asin();
+double r_asin(x) real *x;
+#else
+#undef abs
+#include <math.h>
+double r_asin(real *x)
+#endif
+{
+return( asin(*x) );
+}
diff --git a/gcc/f/runtime/libF77/r_atan.c b/gcc/f/runtime/libF77/r_atan.c
new file mode 100644
index 00000000000..36479c915b0
--- /dev/null
+++ b/gcc/f/runtime/libF77/r_atan.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double atan();
+double r_atan(x) real *x;
+#else
+#undef abs
+#include <math.h>
+double r_atan(real *x)
+#endif
+{
+return( atan(*x) );
+}
diff --git a/gcc/f/runtime/libF77/r_atn2.c b/gcc/f/runtime/libF77/r_atn2.c
new file mode 100644
index 00000000000..9347e1f13a9
--- /dev/null
+++ b/gcc/f/runtime/libF77/r_atn2.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double atan2();
+double r_atn2(x,y) real *x, *y;
+#else
+#undef abs
+#include <math.h>
+double r_atn2(real *x, real *y)
+#endif
+{
+return( atan2(*x,*y) );
+}
diff --git a/gcc/f/runtime/libF77/r_cnjg.c b/gcc/f/runtime/libF77/r_cnjg.c
new file mode 100644
index 00000000000..b6175eedfd7
--- /dev/null
+++ b/gcc/f/runtime/libF77/r_cnjg.c
@@ -0,0 +1,16 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+VOID r_cnjg(resx, z) complex *resx, *z;
+#else
+VOID r_cnjg(complex *resx, complex *z)
+#endif
+{
+complex res;
+
+res.r = z->r;
+res.i = - z->i;
+
+resx->r = res.r;
+resx->i = res.i;
+}
diff --git a/gcc/f/runtime/libF77/r_cos.c b/gcc/f/runtime/libF77/r_cos.c
new file mode 100644
index 00000000000..5bda158cee9
--- /dev/null
+++ b/gcc/f/runtime/libF77/r_cos.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double cos();
+double r_cos(x) real *x;
+#else
+#undef abs
+#include <math.h>
+double r_cos(real *x)
+#endif
+{
+return( cos(*x) );
+}
diff --git a/gcc/f/runtime/libF77/r_cosh.c b/gcc/f/runtime/libF77/r_cosh.c
new file mode 100644
index 00000000000..7ae72cc0cef
--- /dev/null
+++ b/gcc/f/runtime/libF77/r_cosh.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double cosh();
+double r_cosh(x) real *x;
+#else
+#undef abs
+#include <math.h>
+double r_cosh(real *x)
+#endif
+{
+return( cosh(*x) );
+}
diff --git a/gcc/f/runtime/libF77/r_dim.c b/gcc/f/runtime/libF77/r_dim.c
new file mode 100644
index 00000000000..baca95cd9e4
--- /dev/null
+++ b/gcc/f/runtime/libF77/r_dim.c
@@ -0,0 +1,10 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double r_dim(a,b) real *a, *b;
+#else
+double r_dim(real *a, real *b)
+#endif
+{
+return( *a > *b ? *a - *b : 0);
+}
diff --git a/gcc/f/runtime/libF77/r_exp.c b/gcc/f/runtime/libF77/r_exp.c
new file mode 100644
index 00000000000..d1dea75563f
--- /dev/null
+++ b/gcc/f/runtime/libF77/r_exp.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double exp();
+double r_exp(x) real *x;
+#else
+#undef abs
+#include <math.h>
+double r_exp(real *x)
+#endif
+{
+return( exp(*x) );
+}
diff --git a/gcc/f/runtime/libF77/r_imag.c b/gcc/f/runtime/libF77/r_imag.c
new file mode 100644
index 00000000000..d51252bbb79
--- /dev/null
+++ b/gcc/f/runtime/libF77/r_imag.c
@@ -0,0 +1,10 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double r_imag(z) complex *z;
+#else
+double r_imag(complex *z)
+#endif
+{
+return(z->i);
+}
diff --git a/gcc/f/runtime/libF77/r_int.c b/gcc/f/runtime/libF77/r_int.c
new file mode 100644
index 00000000000..8378e775726
--- /dev/null
+++ b/gcc/f/runtime/libF77/r_int.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double floor();
+double r_int(x) real *x;
+#else
+#undef abs
+#include <math.h>
+double r_int(real *x)
+#endif
+{
+return( (*x>0) ? floor(*x) : -floor(- *x) );
+}
diff --git a/gcc/f/runtime/libF77/r_lg10.c b/gcc/f/runtime/libF77/r_lg10.c
new file mode 100644
index 00000000000..51f84201711
--- /dev/null
+++ b/gcc/f/runtime/libF77/r_lg10.c
@@ -0,0 +1,15 @@
+#include "f2c.h"
+
+#define log10e 0.43429448190325182765
+
+#ifdef KR_headers
+double log();
+double r_lg10(x) real *x;
+#else
+#undef abs
+#include <math.h>
+double r_lg10(real *x)
+#endif
+{
+return( log10e * log(*x) );
+}
diff --git a/gcc/f/runtime/libF77/r_log.c b/gcc/f/runtime/libF77/r_log.c
new file mode 100644
index 00000000000..4873fb418e8
--- /dev/null
+++ b/gcc/f/runtime/libF77/r_log.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double log();
+double r_log(x) real *x;
+#else
+#undef abs
+#include <math.h>
+double r_log(real *x)
+#endif
+{
+return( log(*x) );
+}
diff --git a/gcc/f/runtime/libF77/r_mod.c b/gcc/f/runtime/libF77/r_mod.c
new file mode 100644
index 00000000000..faea344a7b7
--- /dev/null
+++ b/gcc/f/runtime/libF77/r_mod.c
@@ -0,0 +1,40 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+#ifdef IEEE_drem
+double drem();
+#else
+double floor();
+#endif
+double r_mod(x,y) real *x, *y;
+#else
+#ifdef IEEE_drem
+double drem(double, double);
+#else
+#undef abs
+#include <math.h>
+#endif
+double r_mod(real *x, real *y)
+#endif
+{
+#ifdef IEEE_drem
+	double xa, ya, z;
+	if ((ya = *y) < 0.)
+		ya = -ya;
+	z = drem(xa = *x, ya);
+	if (xa > 0) {
+		if (z < 0)
+			z += ya;
+		}
+	else if (z > 0)
+		z -= ya;
+	return z;
+#else
+	double quotient;
+	if( (quotient = (double)*x / *y) >= 0)
+		quotient = floor(quotient);
+	else
+		quotient = -floor(-quotient);
+	return(*x - (*y) * quotient );
+#endif
+}
diff --git a/gcc/f/runtime/libF77/r_nint.c b/gcc/f/runtime/libF77/r_nint.c
new file mode 100644
index 00000000000..f5382af660a
--- /dev/null
+++ b/gcc/f/runtime/libF77/r_nint.c
@@ -0,0 +1,14 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double floor();
+double r_nint(x) real *x;
+#else
+#undef abs
+#include <math.h>
+double r_nint(real *x)
+#endif
+{
+return( (*x)>=0 ?
+	floor(*x + .5) : -floor(.5 - *x) );
+}
diff --git a/gcc/f/runtime/libF77/r_sign.c b/gcc/f/runtime/libF77/r_sign.c
new file mode 100644
index 00000000000..df6d02af00a
--- /dev/null
+++ b/gcc/f/runtime/libF77/r_sign.c
@@ -0,0 +1,12 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double r_sign(a,b) real *a, *b;
+#else
+double r_sign(real *a, real *b)
+#endif
+{
+double x;
+x = (*a >= 0 ? *a : - *a);
+return( *b >= 0 ? x : -x);
+}
diff --git a/gcc/f/runtime/libF77/r_sin.c b/gcc/f/runtime/libF77/r_sin.c
new file mode 100644
index 00000000000..095b9510de9
--- /dev/null
+++ b/gcc/f/runtime/libF77/r_sin.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double sin();
+double r_sin(x) real *x;
+#else
+#undef abs
+#include <math.h>
+double r_sin(real *x)
+#endif
+{
+return( sin(*x) );
+}
diff --git a/gcc/f/runtime/libF77/r_sinh.c b/gcc/f/runtime/libF77/r_sinh.c
new file mode 100644
index 00000000000..3bf4bb138be
--- /dev/null
+++ b/gcc/f/runtime/libF77/r_sinh.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double sinh();
+double r_sinh(x) real *x;
+#else
+#undef abs
+#include <math.h>
+double r_sinh(real *x)
+#endif
+{
+return( sinh(*x) );
+}
diff --git a/gcc/f/runtime/libF77/r_sqrt.c b/gcc/f/runtime/libF77/r_sqrt.c
new file mode 100644
index 00000000000..d0203d3d19b
--- /dev/null
+++ b/gcc/f/runtime/libF77/r_sqrt.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double sqrt();
+double r_sqrt(x) real *x;
+#else
+#undef abs
+#include <math.h>
+double r_sqrt(real *x)
+#endif
+{
+return( sqrt(*x) );
+}
diff --git a/gcc/f/runtime/libF77/r_tan.c b/gcc/f/runtime/libF77/r_tan.c
new file mode 100644
index 00000000000..fc0009e4774
--- /dev/null
+++ b/gcc/f/runtime/libF77/r_tan.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double tan();
+double r_tan(x) real *x;
+#else
+#undef abs
+#include <math.h>
+double r_tan(real *x)
+#endif
+{
+return( tan(*x) );
+}
diff --git a/gcc/f/runtime/libF77/r_tanh.c b/gcc/f/runtime/libF77/r_tanh.c
new file mode 100644
index 00000000000..818c6a8451b
--- /dev/null
+++ b/gcc/f/runtime/libF77/r_tanh.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double tanh();
+double r_tanh(x) real *x;
+#else
+#undef abs
+#include <math.h>
+double r_tanh(real *x)
+#endif
+{
+return( tanh(*x) );
+}
diff --git a/gcc/f/runtime/libF77/s_cat.c b/gcc/f/runtime/libF77/s_cat.c
new file mode 100644
index 00000000000..f462fd24945
--- /dev/null
+++ b/gcc/f/runtime/libF77/s_cat.c
@@ -0,0 +1,75 @@
+/* Unless compiled with -DNO_OVERWRITE, this variant of s_cat allows the
+ * target of a concatenation to appear on its right-hand side (contrary
+ * to the Fortran 77 Standard, but in accordance with Fortran 90).
+ */
+
+#include "f2c.h"
+#ifndef NO_OVERWRITE
+#include <stdio.h>
+#undef abs
+#ifdef KR_headers
+ extern char *F77_aloc();
+ extern void free();
+ extern void G77_exit_0 ();
+#else
+#undef min
+#undef max
+#include <stdlib.h>
+ extern char *F77_aloc(ftnlen, char*);
+#endif
+#include <string.h>
+#endif /* NO_OVERWRITE */
+
+ VOID
+#ifdef KR_headers
+s_cat(lp, rpp, rnp, np, ll) char *lp, *rpp[]; ftnlen rnp[], *np, ll;
+#else
+s_cat(char *lp, char *rpp[], ftnlen rnp[], ftnlen *np, ftnlen ll)
+#endif
+{
+	ftnlen i, nc;
+	char *rp;
+	ftnlen n = *np;
+#ifndef NO_OVERWRITE
+	ftnlen L, m;
+	char *lp0, *lp1;
+
+	lp0 = 0;
+	lp1 = lp;
+	L = ll;
+	i = 0;
+	while(i < n) {
+		rp = rpp[i];
+		m = rnp[i++];
+		if (rp >= lp1 || rp + m <= lp) {
+			if ((L -= m) <= 0) {
+				n = i;
+				break;
+				}
+			lp1 += m;
+			continue;
+			}
+		lp0 = lp;
+		lp = lp1 = F77_aloc(L = ll, "s_cat");
+		break;
+		}
+	lp1 = lp;
+#endif /* NO_OVERWRITE */
+	for(i = 0 ; i < n ; ++i) {
+		nc = ll;
+		if(rnp[i] < nc)
+			nc = rnp[i];
+		ll -= nc;
+		rp = rpp[i];
+		while(--nc >= 0)
+			*lp++ = *rp++;
+		}
+	while(--ll >= 0)
+		*lp++ = ' ';
+#ifndef NO_OVERWRITE
+	if (lp0) {
+		memcpy(lp0, lp1, L);
+		free(lp1);
+		}
+#endif
+	}
diff --git a/gcc/f/runtime/libF77/s_cmp.c b/gcc/f/runtime/libF77/s_cmp.c
new file mode 100644
index 00000000000..1e052f28642
--- /dev/null
+++ b/gcc/f/runtime/libF77/s_cmp.c
@@ -0,0 +1,44 @@
+#include "f2c.h"
+
+/* compare two strings */
+
+#ifdef KR_headers
+integer s_cmp(a0, b0, la, lb) char *a0, *b0; ftnlen la, lb;
+#else
+integer s_cmp(char *a0, char *b0, ftnlen la, ftnlen lb)
+#endif
+{
+register unsigned char *a, *aend, *b, *bend;
+a = (unsigned char *)a0;
+b = (unsigned char *)b0;
+aend = a + la;
+bend = b + lb;
+
+if(la <= lb)
+	{
+	while(a < aend)
+		if(*a != *b)
+			return( *a - *b );
+		else
+			{ ++a; ++b; }
+
+	while(b < bend)
+		if(*b != ' ')
+			return( ' ' - *b );
+		else	++b;
+	}
+
+else
+	{
+	while(b < bend)
+		if(*a == *b)
+			{ ++a; ++b; }
+		else
+			return( *a - *b );
+	while(a < aend)
+		if(*a != ' ')
+			return(*a - ' ');
+		else	++a;
+	}
+return(0);
+}
diff --git a/gcc/f/runtime/libF77/s_copy.c b/gcc/f/runtime/libF77/s_copy.c
new file mode 100644
index 00000000000..d1673510c62
--- /dev/null
+++ b/gcc/f/runtime/libF77/s_copy.c
@@ -0,0 +1,51 @@
+/* Unless compiled with -DNO_OVERWRITE, this variant of s_copy allows the
+ * target of an assignment to appear on its right-hand side (contrary
+ * to the Fortran 77 Standard, but in accordance with Fortran 90),
+ * as in  a(2:5) = a(4:7) .
+ */
+
+#include "f2c.h"
+
+/* assign strings:  a = b */
+
+#ifdef KR_headers
+VOID s_copy(a, b, la, lb) register char *a, *b; ftnlen la, lb;
+#else
+void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb)
+#endif
+{
+	register char *aend, *bend;
+
+	aend = a + la;
+
+	if(la <= lb)
+#ifndef NO_OVERWRITE
+		if (a <= b || a >= b + la)
+#endif
+			while(a < aend)
+				*a++ = *b++;
+#ifndef NO_OVERWRITE
+		else
+			for(b += la; a < aend; )
+				*--aend = *--b;
+#endif
+
+	else {
+		bend = b + lb;
+#ifndef NO_OVERWRITE
+		if (a <= b || a >= bend)
+#endif
+			while(b < bend)
+				*a++ = *b++;
+#ifndef NO_OVERWRITE
+		else {
+			a += lb;
+			while(b < bend)
+				*--a = *--bend;
+			a += lb;
+			}
+#endif
+		while(a < aend)
+			*a++ = ' ';
+		}
+	}
diff --git a/gcc/f/runtime/libF77/s_paus.c b/gcc/f/runtime/libF77/s_paus.c
new file mode 100644
index 00000000000..1317008cb73
--- /dev/null
+++ b/gcc/f/runtime/libF77/s_paus.c
@@ -0,0 +1,88 @@
+#include <stdio.h>
+#include "f2c.h"
+#define PAUSESIG 15
+
+#ifdef KR_headers
+#define Void /* void */
+#define Int /* int */
+#else
+#define Void void
+#define Int int
+#undef abs
+#undef min
+#undef max
+#include <stdlib.h>
+#include "signal1.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern int getpid(void), isatty(int), pause(void);
+#endif
+
+extern VOID f_exit(Void);
+
+ static VOID
+waitpause(Int n)
+{	n = n; /* shut up compiler warning */
+	return;
+	}
+
+ static VOID
+#ifdef KR_headers
+s_1paus(fin) FILE *fin;
+#else
+s_1paus(FILE *fin)
+#endif
+{
+	fprintf(stderr,
+	"To resume execution, type go.  Other input will terminate the job.\n");
+	fflush(stderr);
+	if( getc(fin)!='g' || getc(fin)!='o' || getc(fin)!='\n' ) {
+		fprintf(stderr, "STOP\n");
+#ifdef NO_ONEXIT
+		f_exit();
+#endif
+		exit(0);
+		}
+	}
+
+ int
+#ifdef KR_headers
+s_paus(s, n) char *s; ftnlen n;
+#else
+s_paus(char *s, ftnlen n)
+#endif
+{
+	fprintf(stderr, "PAUSE ");
+	if(n > 0)
+		fprintf(stderr, " %.*s", (int)n, s);
+	fprintf(stderr, " statement executed\n");
+	if( isatty(fileno(stdin)) )
+		s_1paus(stdin);
+	else {
+#if (defined (MSDOS) && !defined (GO32)) || defined(__CYGWIN32__)
+		FILE *fin;
+		fin = fopen("con", "r");
+		if (!fin) {
+			fprintf(stderr, "s_paus: can't open con!\n");
+			fflush(stderr);
+			exit(1);
+			}
+		s_1paus(fin);
+		fclose(fin);
+#else
+		fprintf(stderr,
+		"To resume execution, execute a   kill -%d %d   command\n",
+			PAUSESIG, getpid() );
+		signal1(PAUSESIG, waitpause);
+		fflush(stderr);
+		pause();
+#endif
+		}
+	fprintf(stderr, "Execution resumes after PAUSE.\n");
+	fflush(stderr);
+	return 0; /* NOT REACHED */
+#ifdef __cplusplus
+	}
+#endif
+}
diff --git a/gcc/f/runtime/libF77/s_rnge.c b/gcc/f/runtime/libF77/s_rnge.c
new file mode 100644
index 00000000000..189b5247ced
--- /dev/null
+++ b/gcc/f/runtime/libF77/s_rnge.c
@@ -0,0 +1,26 @@
+#include <stdio.h>
+#include "f2c.h"
+
+/* called when a subscript is out of range */
+
+#ifdef KR_headers
+extern VOID sig_die();
+integer s_rnge(varn, offset, procn, line) char *varn, *procn; ftnint offset, line;
+#else
+extern VOID sig_die(char*,int);
+integer s_rnge(char *varn, ftnint offset, char *procn, ftnint line)
+#endif
+{
+register int i;
+
+fprintf(stderr, "Subscript out of range on file line %ld, procedure ", line);
+while((i = *procn) && i != '_' && i != ' ')
+	putc(*procn++, stderr);
+fprintf(stderr, ".\nAttempt to access the %ld-th element of variable ", offset+1);
+while((i = *varn) && i != ' ')
+	putc(*varn++, stderr);
+sig_die(".", 1);
+#ifdef __cplusplus
+return 0;
+#endif
+}
diff --git a/gcc/f/runtime/libF77/s_stop.c b/gcc/f/runtime/libF77/s_stop.c
new file mode 100644
index 00000000000..2e3f1035b30
--- /dev/null
+++ b/gcc/f/runtime/libF77/s_stop.c
@@ -0,0 +1,37 @@
+#include <stdio.h>
+#include "f2c.h"
+
+#ifdef KR_headers
+extern void f_exit();
+VOID s_stop(s, n) char *s; ftnlen n;
+#else
+#undef abs
+#undef min
+#undef max
+#include <stdlib.h>
+#ifdef __cplusplus
+extern "C" {
+#endif
+void f_exit(void);
+
+int s_stop(char *s, ftnlen n)
+#endif
+{
+int i;
+
+if(n > 0)
+	{
+	fprintf(stderr, "STOP ");
+	for(i = 0; i<n ; ++i)
+		putc(*s++, stderr);
+	fprintf(stderr, " statement executed\n");
+	}
+#ifdef NO_ONEXIT
+f_exit();
+#endif
+exit(0);
+#ifdef __cplusplus
+return 0; /* NOT REACHED */
+}
+#endif
+}
diff --git a/gcc/f/runtime/libF77/sig_die.c b/gcc/f/runtime/libF77/sig_die.c
new file mode 100644
index 00000000000..bebb1e7b8f7
--- /dev/null
+++ b/gcc/f/runtime/libF77/sig_die.c
@@ -0,0 +1,45 @@
+#include <stdio.h>
+#include <signal.h>
+
+#ifndef SIGIOT
+#ifdef SIGABRT
+#define SIGIOT SIGABRT
+#endif
+#endif
+
+#ifdef KR_headers
+void sig_die(s, kill) register char *s; int kill;
+#else
+#include <stdlib.h>
+#ifdef __cplusplus
+extern "C" {
+#endif
+ extern void f_exit(void);
+
+void sig_die(register char *s, int kill)
+#endif
+{
+	/* print error message, then clear buffers */
+	fprintf(stderr, "%s\n", s);
+
+	if(kill)
+		{
+		fflush(stderr);
+		f_exit();
+		fflush(stderr);
+		/* now get a core */
+#ifdef SIGIOT
+		signal(SIGIOT, SIG_DFL);
+#endif
+		abort();
+		}
+	else {
+#ifdef NO_ONEXIT
+		f_exit();
+#endif
+		exit(1);
+		}
+	}
+#ifdef __cplusplus
+}
+#endif
diff --git a/gcc/f/runtime/libF77/signal1.h b/gcc/f/runtime/libF77/signal1.h
new file mode 100644
index 00000000000..b559211e8e4
--- /dev/null
+++ b/gcc/f/runtime/libF77/signal1.h
@@ -0,0 +1,5 @@
+/* The g77 implementation of libf2c directly includes signal1.h0,
+   instead of copying it to signal1.h, since that seems easier to
+   cope with at this point.  */
+
+#include "signal1.h0"
diff --git a/gcc/f/runtime/libF77/signal1.h0 b/gcc/f/runtime/libF77/signal1.h0
new file mode 100644
index 00000000000..8800a18d77b
--- /dev/null
+++ b/gcc/f/runtime/libF77/signal1.h0
@@ -0,0 +1,25 @@
+/* You may need to adjust the definition of signal1 to supply a */
+/* cast to the correct argument type.  This detail is system- and */
+/* compiler-dependent.   The #define below assumes signal.h declares */
+/* type SIG_PF for the signal function's second argument. */
+
+#include <signal.h>
+
+#ifndef Sigret_t
+#define Sigret_t void
+#endif
+#ifndef Sigarg_t
+#ifdef KR_headers
+#define Sigarg_t
+#else
+#define Sigarg_t int
+#endif
+#endif /*Sigarg_t*/
+
+#ifdef USE_SIG_PF	/* compile with -DUSE_SIG_PF under IRIX */
+#define sig_pf SIG_PF
+#else
+typedef Sigret_t (*sig_pf)(Sigarg_t);
+#endif
+
+#define signal1(a,b) signal(a,(sig_pf)b)
diff --git a/gcc/f/runtime/libF77/signal_.c b/gcc/f/runtime/libF77/signal_.c
new file mode 100644
index 00000000000..1ac81391aef
--- /dev/null
+++ b/gcc/f/runtime/libF77/signal_.c
@@ -0,0 +1,14 @@
+#include "f2c.h"
+#include "signal1.h"
+
+#ifdef KR_headers
+ftnint G77_signal_0 (sigp, proc) integer *sigp; sig_pf proc;
+#else
+ftnint G77_signal_0 (integer *sigp, sig_pf proc)
+#endif
+{
+	int sig;
+	sig = (int)*sigp;
+
+	return (ftnint)signal(sig, proc);
+	}
diff --git a/gcc/f/runtime/libF77/system_.c b/gcc/f/runtime/libF77/system_.c
new file mode 100644
index 00000000000..ed024a14ded
--- /dev/null
+++ b/gcc/f/runtime/libF77/system_.c
@@ -0,0 +1,36 @@
+/* f77 interface to system routine */
+
+#include "f2c.h"
+
+#ifdef KR_headers
+extern char *F77_aloc();
+
+ integer
+G77_system_0 (s, n) register char *s; ftnlen n;
+#else
+#undef abs
+#undef min
+#undef max
+#include <stdlib.h>
+extern char *F77_aloc(ftnlen, char*);
+
+ integer
+G77_system_0 (register char *s, ftnlen n)
+#endif
+{
+	char buff0[256], *buff;
+	register char *bp, *blast;
+	integer rv;
+
+	buff = bp = n < sizeof(buff0)
+			? buff0 : F77_aloc(n+1, "system_");
+	blast = bp + n;
+
+	while(bp < blast && *s)
+		*bp++ = *s++;
+	*bp = 0;
+	rv = system(buff);
+	if (buff != buff0)
+		free(buff);
+	return rv;
+	}
diff --git a/gcc/f/runtime/libF77/z_abs.c b/gcc/f/runtime/libF77/z_abs.c
new file mode 100644
index 00000000000..7e67ad2957f
--- /dev/null
+++ b/gcc/f/runtime/libF77/z_abs.c
@@ -0,0 +1,12 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double f__cabs();
+double z_abs(z) doublecomplex *z;
+#else
+double f__cabs(double, double);
+double z_abs(doublecomplex *z)
+#endif
+{
+return( f__cabs( z->r, z->i ) );
+}
diff --git a/gcc/f/runtime/libF77/z_cos.c b/gcc/f/runtime/libF77/z_cos.c
new file mode 100644
index 00000000000..a811bbecc65
--- /dev/null
+++ b/gcc/f/runtime/libF77/z_cos.c
@@ -0,0 +1,19 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double sin(), cos(), sinh(), cosh();
+VOID z_cos(resx, z) doublecomplex *resx, *z;
+#else
+#undef abs
+#include <math.h>
+void z_cos(doublecomplex *resx, doublecomplex *z)
+#endif
+{
+doublecomplex res;
+
+res.r = cos(z->r) * cosh(z->i);
+res.i = - sin(z->r) * sinh(z->i);
+
+resx->r = res.r;
+resx->i = res.i;
+}
diff --git a/gcc/f/runtime/libF77/z_div.c b/gcc/f/runtime/libF77/z_div.c
new file mode 100644
index 00000000000..4a987ab255a
--- /dev/null
+++ b/gcc/f/runtime/libF77/z_div.c
@@ -0,0 +1,39 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+extern VOID sig_die();
+VOID z_div(resx, a, b) doublecomplex *a, *b, *resx;
+#else
+extern void sig_die(char*, int);
+void z_div(doublecomplex *resx, doublecomplex *a, doublecomplex *b)
+#endif
+{
+double ratio, den;
+double abr, abi;
+doublecomplex res;
+
+if( (abr = b->r) < 0.)
+	abr = - abr;
+if( (abi = b->i) < 0.)
+	abi = - abi;
+if( abr <= abi )
+	{
+	if(abi == 0)
+		sig_die("complex division by zero", 1);
+	ratio = b->r / b->i ;
+	den = b->i * (1 + ratio*ratio);
+	res.r = (a->r*ratio + a->i) / den;
+	res.i = (a->i*ratio - a->r) / den;
+	}
+
+else
+	{
+	ratio = b->i / b->r ;
+	den = b->r * (1 + ratio*ratio);
+	res.r = (a->r + a->i*ratio) / den;
+	res.i = (a->i - a->r*ratio) / den;
+	}
+
+resx->r = res.r;
+resx->i = res.i;
+}
diff --git a/gcc/f/runtime/libF77/z_exp.c b/gcc/f/runtime/libF77/z_exp.c
new file mode 100644
index 00000000000..85fb63e4209
--- /dev/null
+++ b/gcc/f/runtime/libF77/z_exp.c
@@ -0,0 +1,21 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double exp(), cos(), sin();
+VOID z_exp(resx, z) doublecomplex *resx, *z;
+#else
+#undef abs
+#include <math.h>
+void z_exp(doublecomplex *resx, doublecomplex *z)
+#endif
+{
+double expx;
+doublecomplex res;
+
+expx = exp(z->r);
+res.r = expx * cos(z->i);
+res.i = expx * sin(z->i);
+
+resx->r = res.r;
+resx->i = res.i;
+}
diff --git a/gcc/f/runtime/libF77/z_log.c b/gcc/f/runtime/libF77/z_log.c
new file mode 100644
index 00000000000..48afca63d6d
--- /dev/null
+++ b/gcc/f/runtime/libF77/z_log.c
@@ -0,0 +1,20 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double log(), f__cabs(), atan2();
+VOID z_log(resx, z) doublecomplex *resx, *z;
+#else
+#undef abs
+#include <math.h>
+extern double f__cabs(double, double);
+void z_log(doublecomplex *resx, doublecomplex *z)
+#endif
+{
+doublecomplex res;
+
+res.i = atan2(z->i, z->r);
+res.r = log( f__cabs( z->r, z->i ) );
+
+resx->r = res.r;
+resx->i = res.i;
+}
diff --git a/gcc/f/runtime/libF77/z_sin.c b/gcc/f/runtime/libF77/z_sin.c
new file mode 100644
index 00000000000..94456c9c30a
--- /dev/null
+++ b/gcc/f/runtime/libF77/z_sin.c
@@ -0,0 +1,19 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double sin(), cos(), sinh(), cosh();
+VOID z_sin(resx, z) doublecomplex *resx, *z;
+#else
+#undef abs
+#include <math.h>
+void z_sin(doublecomplex *resx, doublecomplex *z)
+#endif
+{
+doublecomplex res;
+
+res.r = sin(z->r) * cosh(z->i);
+res.i = cos(z->r) * sinh(z->i);
+
+resx->r = res.r;
+resx->i = res.i;
+}
diff --git a/gcc/f/runtime/libF77/z_sqrt.c b/gcc/f/runtime/libF77/z_sqrt.c
new file mode 100644
index 00000000000..f5db5651991
--- /dev/null
+++ b/gcc/f/runtime/libF77/z_sqrt.c
@@ -0,0 +1,33 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+double sqrt(), f__cabs();
+VOID z_sqrt(resx, z) doublecomplex *resx, *z;
+#else
+#undef abs
+#include <math.h>
+extern double f__cabs(double, double);
+void z_sqrt(doublecomplex *resx, doublecomplex *z)
+#endif
+{
+double mag;
+doublecomplex res;
+
+if( (mag = f__cabs(z->r, z->i)) == 0.)
+	res.r = res.i = 0.;
+else if(z->r > 0)
+	{
+	res.r = sqrt(0.5 * (mag + z->r) );
+	res.i = z->i / res.r / 2;
+	}
+else
+	{
+	res.i = sqrt(0.5 * (mag - z->r) );
+	if(z->i < 0)
+		res.i = - res.i;
+	res.r = z->i / res.i / 2;
+	}
+
+resx->r = res.r;
+resx->i = res.i;
+}
diff --git a/gcc/f/runtime/libI77/Makefile.in b/gcc/f/runtime/libI77/Makefile.in
new file mode 100644
index 00000000000..34bc5fa3997
--- /dev/null
+++ b/gcc/f/runtime/libI77/Makefile.in
@@ -0,0 +1,129 @@
+# Makefile for GNU F77 compiler runtime.
+# Copyright 1990 - 1994 by AT&T Bell Laboratories and Bellcore (see the
+# file `Notice').
+#   Portions of this file Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+#   Contributed by Dave Love (d.love@dl.ac.uk).
+#
+#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.
+
+SHELL = /bin/sh
+
+srcdir = @srcdir@
+VPATH = @srcdir@
+
+#### Start of system configuration section. ####
+
+# The _FOR_TARGET things are appropriate for a cross-make, passed by the
+# superior makefile
+GCC_FOR_TARGET = @CC@
+CC = $(GCC_FOR_TARGET)
+CFLAGS = @CFLAGS@ $(GCC_FLAGS)
+CPPFLAGS = @CPPFLAGS@
+DEFS = @DEFS@
+CGFLAGS = -g0
+# f2c.h should already be installed in xgcc's include directory but add that
+# to -I anyhow in case not using xgcc.
+ALL_CFLAGS = -I. -I$(srcdir) -I../../../include $(CPPFLAGS) $(DEFS) $(CFLAGS)
+AR = @AR@
+AR_FLAGS = rc
+RANLIB = @RANLIB@
+RANLIB_TEST = @RANLIB_TEST@
+CROSS = @CROSS@
+
+.SUFFIXES:
+.SUFFIXES: .c .o
+
+.c.o:
+	$(CC) -c -DSkip_f2c_Undefs -DAllow_TYQUAD $(ALL_CFLAGS) $(CGFLAGS) $<
+
+OBJ =	VersionI.o backspace.o close.o dfe.o dolio.o due.o endfile.o err.o \
+	fmt.o fmtlib.o iio.o ilnw.o inquire.o lread.o lwrite.o open.o \
+	rdfmt.o rewind.o rsfe.o rsli.o rsne.o sfe.o sue.o typesize.o uio.o \
+	util.o wref.o wrtfmt.o wsfe.o wsle.o wsne.o xwsne.o \
+	ftell_.o
+
+F2C_H = ../../../include/f2c.h
+
+all: $(OBJ)
+
+VersionI.o: Version.c
+	$(CC) -c $(CGFLAGS) -o $@ $(srcdir)/Version.c
+
+mostlyclean clean:
+	-rm -f $(OBJ)
+
+distclean maintainer-clean: mostlyclean
+	-rm -f stage? include Makefile
+
+backspace.o:	fio.h
+close.o:	fio.h
+dfe.o:		fio.h
+dfe.o:		fmt.h
+due.o:		fio.h
+endfile.o:	fio.h rawio.h
+err.o:		fio.h rawio.h
+fmt.o:		fio.h
+fmt.o:		fmt.h
+ftell_.o:	fio.h
+iio.o:		fio.h
+iio.o:		fmt.h
+ilnw.o:		fio.h
+ilnw.o:		lio.h
+inquire.o:	fio.h
+lread.o:	fio.h
+lread.o:	fmt.h
+lread.o:	lio.h
+lread.o:	fp.h
+lwrite.o:	fio.h
+lwrite.o:	fmt.h
+lwrite.o:	lio.h
+open.o:		fio.h rawio.h
+rdfmt.o:	fio.h
+rdfmt.o:	fmt.h
+rdfmt.o:	fp.h
+rewind.o:	fio.h
+rsfe.o:		fio.h
+rsfe.o:		fmt.h
+rsli.o:		fio.h
+rsli.o:		lio.h
+rsne.o:		fio.h
+rsne.o:		lio.h
+sfe.o:		fio.h
+sue.o:		fio.h
+uio.o:		fio.h
+util.o:		fio.h
+wref.o:		fio.h
+wref.o:		fmt.h
+wref.o:		fp.h
+wrtfmt.o:	fio.h
+wrtfmt.o:	fmt.h
+wsfe.o:		fio.h
+wsfe.o:		fmt.h
+wsle.o:		fio.h
+wsle.o:		fmt.h
+wsle.o:		lio.h
+wsne.o:		fio.h
+wsne.o:		lio.h
+xwsne.o:	fio.h
+xwsne.o:	lio.h
+xwsne.o:	fmt.h
+
+# May be pessimistic:
+$(OBJ): $(F2C_H)
+
+.PHONY: mostlyclean clean distclean maintainer-clean all
diff --git a/gcc/f/runtime/libI77/Notice b/gcc/f/runtime/libI77/Notice
new file mode 100644
index 00000000000..261b719bc57
--- /dev/null
+++ b/gcc/f/runtime/libI77/Notice
@@ -0,0 +1,23 @@
+/****************************************************************
+Copyright 1990 - 1997 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
diff --git a/gcc/f/runtime/libI77/README.netlib b/gcc/f/runtime/libI77/README.netlib
new file mode 100644
index 00000000000..30dd5b5223d
--- /dev/null
+++ b/gcc/f/runtime/libI77/README.netlib
@@ -0,0 +1,225 @@
+If your compiler does not recognize ANSI C headers,
+compile with KR_headers defined:  either add -DKR_headers
+to the definition of CFLAGS in the makefile, or insert
+
+#define KR_headers
+
+at the top of f2c.h and fmtlib.c .
+
+
+If you have a really ancient K&R C compiler that does not understand
+void, add -Dvoid=int to the definition of CFLAGS in the makefile.
+
+If you use a C++ compiler, first create a local f2c.h by appending
+f2ch.add to the usual f2c.h, e.g., by issuing the command
+	make f2c.h
+which assumes f2c.h is installed in /usr/include .
+
+If your system lacks /usr/include/fcntl.h , then you
+should simply create an empty fcntl.h in this directory.
+If your compiler then complains about creat and open not
+having a prototype, compile with OPEN_DECL defined.
+On many systems, open and creat are declared in fcntl.h .
+
+If your system has /usr/include/fcntl.h, you may need to add
+-D_POSIX_SOURCE to the makefile's definition of CFLAGS.
+
+If your system's sprintf does not work the way ANSI C
+specifies -- specifically, if it does not return the
+number of characters transmitted -- then insert the line
+
+#define USE_STRLEN
+
+at the end of fmt.h .  This is necessary with
+at least some versions of Sun and DEC software.
+In particular, if you get a warning about an improper
+pointer/integer combination in compiling wref.c, then
+you need to compile with -DUSE_STRLEN .
+
+If your system's fopen does not like the ANSI binary
+reading and writing modes "rb" and "wb", then you should
+compile open.c with NON_ANSI_RW_MODES #defined.
+
+If you get error messages about references to cf->_ptr
+and cf->_base when compiling wrtfmt.c and wsfe.c or to
+stderr->_flag when compiling err.c, then insert the line
+
+#define NON_UNIX_STDIO
+
+at the beginning of fio.h, and recompile everything (or
+at least those modules that contain NON_UNIX_STDIO).
+
+Unformatted sequential records consist of a length of record
+contents, the record contents themselves, and the length of
+record contents again (for backspace).  Prior to 17 Oct. 1991,
+the length was of type int; now it is of type long, but you
+can change it back to int by inserting
+
+#define UIOLEN_int
+
+at the beginning of fio.h.  This affects only sue.c and uio.c .
+
+On VAX, Cray, or Research Tenth-Edition Unix systems, you may
+need to add -DVAX, -DCRAY, or -DV10 (respectively) to CFLAGS
+to make fp.h work correctly.  Alternatively, you may need to
+edit fp.h to suit your machine.
+
+You may need to supply the following non-ANSI routines:
+
+  fstat(int fileds, struct stat *buf) is similar
+to stat(char *name, struct stat *buf), except that
+the first argument, fileds, is the file descriptor
+returned by open rather than the name of the file.
+fstat is used in the system-dependent routine
+canseek (in the libI77 source file err.c), which
+is supposed to return 1 if it's possible to issue
+seeks on the file in question, 0 if it's not; you may
+need to suitably modify err.c .  On non-UNIX systems,
+you can avoid references to fstat and stat by compiling
+with NON_UNIX_STDIO defined; in that case, you may need
+to supply access(char *Name,0), which is supposed to
+return 0 if file Name exists, nonzero otherwise.
+
+  char * mktemp(char *buf) is supposed to replace the
+6 trailing X's in buf with a unique number and then
+return buf.  The idea is to get a unique name for
+a temporary file.
+
+On non-UNIX systems, you may need to change a few other,
+e.g.: the form of name computed by mktemp() in endfile.c and
+open.c; the use of the open(), close(), and creat() system
+calls in endfile.c, err.c, open.c; and the modes in calls on
+fopen() and fdopen() (and perhaps the use of fdopen() itself
+-- it's supposed to return a FILE* corresponding to a given
+an integer file descriptor) in err.c and open.c (component ufmt
+of struct unit is 1 for formatted I/O -- text mode on some systems
+-- and 0 for unformatted I/O -- binary mode on some systems).
+Compiling with -DNON_UNIX_STDIO omits all references to creat()
+and almost all references to open() and close(), the exception
+being in the function f__isdev() (in open.c).
+
+For MS-DOS, compile all of libI77 with -DMSDOS (which implies
+-DNON_UNIX_STDIO).  You may need to make other compiler-dependent
+adjustments; for example, for Turbo C++ you need to adjust the mktemp
+invocations and to #undef ungetc in lread.c and rsne.c .
+
+If you want to be able to load against libI77 but not libF77,
+then you will need to add sig_die.o (from libF77) to libI77.
+
+If you wish to use translated Fortran that has funny notions
+of record length for direct unformatted I/O (i.e., that assumes
+RECL= values in OPEN statements are not bytes but rather counts
+of some other units -- e.g., 4-character words for VMS), then you
+should insert an appropriate #define for url_Adjust at the
+beginning of open.c .  For VMS Fortran, for example,
+#define url_Adjust(x) x *= 4
+would suffice.
+
+To check for transmission errors, issue the command
+	make check
+This assumes you have the xsum program whose source, xsum.c,
+is distributed as part of "all from f2c/src".  If you do not
+have xsum, you can obtain xsum.c by sending the following E-mail
+message to netlib@netlib.bell-labs.com
+	send xsum.c from f2c/src
+
+The makefile assumes you have installed f2c.h in a standard
+place (and does not cause recompilation when f2c.h is changed);
+f2c.h comes with "all from f2c" (the source for f2c) and is
+available separately ("f2c.h from f2c").
+
+By default, Fortran I/O units 5, 6, and 0 are pre-connected to
+stdin, stdout, and stderr, respectively.  You can change this
+behavior by changing f_init() in err.c to suit your needs.
+Note that f2c assumes READ(*... means READ(5... and WRITE(*...
+means WRITE(6... .  Moreover, an OPEN(n,... statement that does
+not specify a file name (and does not specify STATUS='SCRATCH')
+assumes FILE='fort.n' .  You can change this by editing open.c
+and endfile.c suitably.
+
+Unless you adjust the "#define MXUNIT" line in fio.h, Fortran units
+0, 1, ..., 99 are available, i.e., the highest allowed unit number
+is MXUNIT - 1.
+
+Lines protected from compilation by #ifdef Allow_TYQUAD
+are for a possible extension to 64-bit integers in which
+integer = int = 32 bits and longint = long = 64 bits.
+
+Extensions (Feb. 1993) to NAMELIST processing:
+ 1. Reading a ? instead of &name (the start of a namelist) causes
+the namelist being sought to be written to stdout (unit 6);
+to omit this feature, compile rsne.c with -DNo_Namelist_Questions.
+ 2. Reading the wrong namelist name now leads to an error message
+and an attempt to skip input until the right namelist name is found;
+to omit this feature, compile rsne.c with -DNo_Bad_Namelist_Skip.
+ 3. Namelist writes now insert newlines before each variable; to omit
+this feature, compile xwsne.c with -DNo_Extra_Namelist_Newlines.
+ 4. (Sept. 1995) When looking for the &name that starts namelist
+input, lines whose first non-blank character is something other
+than &, $, or ? are treated as comment lines and ignored, unless
+rsne.c is compiled with -DNo_Namelist_Comments.
+
+Nonstandard extension (Feb. 1993) to open: for sequential files,
+ACCESS='APPEND' (or access='anything else starting with "A" or "a"')
+causes the file to be positioned at end-of-file, so a write will
+append to the file.
+
+Some buggy Fortran programs use unformatted direct I/O to write
+an incomplete record and later read more from that record than
+they have written.  For records other than the last, the unwritten
+portion of the record reads as binary zeros.  The last record is
+a special case: attempting to read more from it than was written
+gives end-of-file -- which may help one find a bug.  Some other
+Fortran I/O libraries treat the last record no differently than
+others and thus give no help in finding the bug of reading more
+than was written.  If you wish to have this behavior, compile
+uio.c with -DPad_UDread .
+
+If you want to be able to catch write failures (e.g., due to a
+disk being full) with an ERR= specifier, compile dfe.c, due.c,
+sfe.c, sue.c, and wsle.c with -DALWAYS_FLUSH.  This will lead to
+slower execution and more I/O, but should make ERR= work as
+expected, provided fflush returns an error return when its
+physical write fails.
+
+Carriage controls are meant to be interpreted by the UNIX col
+program (or a similar program).  Sometimes it's convenient to use
+only ' ' as the carriage control character (normal single spacing).
+If you compile lwrite.c and wsfe.c with -DOMIT_BLANK_CC, formatted
+external output lines will have an initial ' ' quietly omitted,
+making use of the col program unnecessary with output that only
+has ' ' for carriage control.
+
+The Fortran 77 Standard leaves it up to the implementation whether
+formatted writes of floating-point numbers of absolute value < 1 have
+a zero before the decimal point.  By default, libI77 omits such
+superfluous zeros, but you can cause them to appear by compiling
+lwrite.c, wref.c, and wrtfmt.c with -DWANT_LEAD_0 .
+
+If your system lacks a ranlib command, you don't need it.
+Either comment out the makefile's ranlib invocation, or install
+a harmless "ranlib" command somewhere in your PATH, such as the
+one-line shell script
+
+	exit 0
+
+or (on some systems)
+
+	exec /usr/bin/ar lts $1 >/dev/null
+
+Most of the routines in libI77 are support routines for Fortran
+I/O.  There are a few exceptions, summarized below -- I/O related
+functions and subroutines that appear to your program as ordinary
+external Fortran routines.
+
+1.	CALL FLUSH flushes all buffers.
+
+2.	FTELL(i) is an INTEGER function that returns the current
+	offset of Fortran unit i (or -1 if unit i is not open).
+
+3.	CALL FSEEK(i, offset, whence, *errlab) attemps to move
+	Fortran unit i to the specified offset: absolute offset
+	if whence = 0; relative to the current offset if whence = 1;
+	relative to the end of the file if whence = 2.  It branches
+	to label errlab if unit i is not open or if the call
+	otherwise fails.
diff --git a/gcc/f/runtime/libI77/Version.c b/gcc/f/runtime/libI77/Version.c
new file mode 100644
index 00000000000..36d4043c056
--- /dev/null
+++ b/gcc/f/runtime/libI77/Version.c
@@ -0,0 +1,272 @@
+static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 19970805\n";
+
+/*
+*/
+
+char __G77_LIBI77_VERSION__[] = "0.5.21-19970811";
+
+/*
+2.01	$ format added
+2.02	Coding bug in open.c repaired
+2.03	fixed bugs in lread.c (read * with negative f-format) and lio.c
+	and lio.h (e-format conforming to spec)
+2.04	changed open.c and err.c (fopen and freopen respectively) to
+	update to new c-library (append mode)
+2.05	added namelist capability
+2.06	allow internal list and namelist I/O
+*/
+
+/*
+close.c:
+	allow upper-case STATUS= values
+endfile.c
+	create fort.nnn if unit nnn not open;
+	else if (file length == 0) use creat() rather than copy;
+	use local copy() rather than forking /bin/cp;
+	rewind, fseek to clear buffer (for no reading past EOF)
+err.c
+	use neither setbuf nor setvbuf; make stderr buffered
+fio.h
+	#define _bufend
+inquire.c
+	upper case responses;
+	omit byfile test from SEQUENTIAL=
+	answer "YES" to DIRECT= for unopened file (open to debate)
+lio.c
+	flush stderr, stdout at end of each stmt
+	space before character strings in list output only at line start
+lio.h
+	adjust LEW, LED consistent with old libI77
+lread.c
+	use atof()
+	allow "nnn*," when reading complex constants
+open.c
+	try opening for writing when open for read fails, with
+	special uwrt value (2) delaying creat() to first write;
+	set curunit so error messages don't drop core;
+	no file name ==> fort.nnn except for STATUS='SCRATCH'
+rdfmt.c
+	use atof(); trust EOF == end-of-file (so don't read past
+	end-of-file after endfile stmt)
+sfe.c
+	flush stderr, stdout at end of each stmt
+wrtfmt.c:
+	use upper case
+	put wrt_E and wrt_F into wref.c, use sprintf()
+		rather than ecvt() and fcvt() [more accurate on VAX]
+*/
+
+/* 16 Oct. 1988: uwrt = 3 after write, rewind, so close won't zap the file. */
+
+/* 10 July 1989: change _bufend to buf_end in fio.h, wsfe.c, wrtfmt.c */
+
+/* 28 Nov. 1989: corrections for IEEE and Cray arithmetic */
+/* 29 Nov. 1989: change various int return types to long for f2c */
+/* 30 Nov. 1989: various types from f2c.h */
+/*  6 Dec. 1989: types corrected various places */
+/* 19 Dec. 1989: make iostat= work right for internal I/O */
+/*  8 Jan. 1990: add rsne, wsne -- routines for handling NAMELIST */
+/* 28 Jan. 1990: have NAMELIST read treat $ as &, general white
+		 space as blank */
+/* 27 Mar. 1990: change an = to == in rd_L(rdfmt.c) so formatted reads
+		 of logical values reject letters other than fFtT;
+		 have nowwriting reset cf */
+/* 14 Aug. 1990: adjust lread.c to treat tabs as spaces in list input */
+/* 17 Aug. 1990: adjust open.c to recognize blank='Z...' as well as
+		 blank='z...' when reopening an open file */
+/* 30 Aug. 1990: prevent embedded blanks in list output of complex values;
+		 omit exponent field in list output of values of
+		 magnitude between 10 and 1e8; prevent writing stdin
+		 and reading stdout or stderr; don't close stdin, stdout,
+		 or stderr when reopening units 5, 6, 0. */
+/* 18 Sep. 1990: add component udev to unit and consider old == new file
+		 iff uinode and udev values agree; use stat rather than
+		 access to check existence of file (when STATUS='OLD')*/
+/* 2 Oct. 1990:  adjust rewind.c so two successive rewinds after a write
+		 don't clobber the file. */
+/* 9 Oct. 1990:  add #include "fcntl.h" to endfile.c, err.c, open.c;
+		 adjust g_char in util.c for segmented memories. */
+/* 17 Oct. 1990: replace abort() and _cleanup() with calls on
+		 sig_die(...,1) (defined in main.c). */
+/* 5 Nov. 1990:  changes to open.c: complain if new= is specified and the
+		 file already exists; allow file= to be omitted in open stmts
+		 and allow status='replace' (Fortran 90 extensions). */
+/* 11 Dec. 1990: adjustments for POSIX. */
+/* 15 Jan. 1991: tweak i_ungetc in rsli.c to allow reading from
+		 strings in read-only memory. */
+/* 25 Apr. 1991: adjust namelist stuff to work with f2c -i2 */
+/* 26 Apr. 1991: fix some bugs with NAMELIST read of multi-dim. arrays */
+/* 16 May 1991:  increase LEFBL in lio.h to bypass NeXT bug */
+/* 17 Oct. 1991: change type of length field in sequential unformatted
+		 records from int to long (for systems where sizeof(int)
+		 can vary, depending on the compiler or compiler options). */
+/* 14 Nov. 1991: change uint to Uint in fmt.h, rdfmt.c, wrtfmt.c. */
+/* 25 Nov. 1991: change uint to Uint in lwrite.c; change sizeof(int) to
+		 sizeof(uioint) in fseeks in sue.c (missed on 17 Oct.). */
+/* 1 Dec. 1991:  uio.c: add test for read failure (seq. unformatted reads);
+		 adjust an error return from EOF to off end of record */
+/* 12 Dec. 1991: rsli.c: fix bug with internal list input that caused
+		 the last character of each record to be ignored.
+		 iio.c: adjust error message in internal formatted
+		 input from "end-of-file" to "off end of record" if
+		 the format specifies more characters than the
+		 record contains. */
+/* 17 Jan. 1992: lread.c, rsne.c: in list and namelist input,
+		 treat "r* ," and "r*," alike (where r is a
+		 positive integer constant), and fix a bug in
+		 handling null values following items with repeat
+		 counts (e.g., 2*1,,3); for namelist reading
+		 of a numeric array, allow a new name-value subsequence
+		 to terminate the current one (as though the current
+		 one ended with the right number of null values).
+		 lio.h, lwrite.c: omit insignificant zeros in
+		 list and namelist output. To get the old
+		 behavior, compile with -DOld_list_output . */
+/* 18 Jan. 1992: make list output consistent with F format by
+		 printing .1 rather than 0.1 (introduced yesterday). */
+/* 3 Feb. 1992:  rsne.c: fix namelist read bug that caused the
+		 character following a comma to be ignored. */
+/* 19 May 1992:  adjust iio.c, ilnw.c, rdfmt.c and rsli.c to make err=
+		 work with internal list and formatted I/O. */
+/* 18 July 1992: adjust rsne.c to allow namelist input to stop at
+		 an & (e.g. &end). */
+/* 23 July 1992: switch to ANSI prototypes unless KR_headers is #defined ;
+		 recognize Z format (assuming 8-bit bytes). */
+/* 14 Aug. 1992: tweak wrt_E in wref.c to avoid -NaN */
+/* 23 Oct. 1992: Supply missing l_eof = 0 assignment to s_rsne() in rsne.c
+		 (so end-of-file on other files won't confuse namelist
+		 reads of external files).  Prepend f__ to external
+		 names that are only of internal interest to lib[FI]77. */
+/* 1 Feb. 1993:  backspace.c: fix bug that bit when last char of 2nd
+		 buffer == '\n'.
+		 endfile.c: guard against tiny L_tmpnam; close and reopen
+		 files in t_runc().
+		 lio.h: lengthen LINTW (buffer size in lwrite.c).
+		 err.c, open.c: more prepending of f__ (to [rw]_mode). */
+/* 5 Feb. 1993:  tweaks to NAMELIST: rsne.c: ? prints the namelist being
+		 sought; namelists of the wrong name are skipped (after
+		 an error message; xwsne.c: namelist writes have a
+		 newline before each new variable.
+		 open.c: ACCESS='APPEND' positions sequential files
+		 at EOF (nonstandard extension -- that doesn't require
+		 changing data structures). */
+/* 9 Feb. 1993:  Change some #ifdef MSDOS lines to #ifdef NON_UNIX_STDIO.
+		 err.c: under NON_UNIX_STDIO, avoid close(creat(name,0666))
+		 when the unit has another file descriptor for name. */
+/* 4 March 1993: err.c, open.c: take declaration of fdopen from rawio.h;
+		 open.c: always give f__w_mode[] 4 elements for use
+		 in t_runc (in endfile.c -- for change of 1 Feb. 1993). */
+/* 6 March 1993: uio.c: adjust off-end-of-record test for sequential
+		 unformatted reads to respond to err= rather than end=. */
+/* 12 March 1993: various tweaks for C++ */
+/* 6 April 1993: adjust error returns for formatted inputs to flush
+		 the current input line when err=label is specified.
+		 To restore the old behavior (input left mid-line),
+		 either adjust the #definition of errfl in fio.h or
+		 omit the invocation of f__doend in err__fl (in err.c).	*/
+/* 23 June 1993: iio.c: fix bug in format reversions for internal writes. */
+/* 5 Aug. 1993:  lread.c: fix bug in handling repetition counts for
+		 logical data (during list or namelist input).
+		 Change struct f__syl to struct syl (for buggy compilers). */
+/* 7 Aug. 1993:  lread.c: fix bug in namelist reading of incomplete
+		 logical arrays. */
+/* 9 Aug. 1993:  lread.c: fix bug in namelist reading of an incomplete
+		 array of numeric data followed by another namelist
+		 item whose name starts with 'd', 'D', 'e', or 'E'. */
+/* 8 Sept. 1993: open.c: protect #include "sys/..." with
+		 #ifndef NON_UNIX_STDIO; Version date not changed. */
+/* 10 Nov. 1993: backspace.c: add nonsense for #ifdef MSDOS */
+/* 8 Dec. 1993:  iio.c: adjust internal formatted reads to treat
+		 short records as though padded with blanks
+		 (rather than causing an "off end of record" error). */
+/* 22 Feb. 1994: lread.c: check that realloc did not return NULL. */
+/* 6 June 1994:  Under NON_UNIX_STDIO, use binary mode for direct
+		 formatted files (avoiding any confusion regarding \n). */
+/* 5 July 1994:  Fix bug (introduced 6 June 1994?) in reopening files
+		 under NON_UNIX_STDIO. */
+/* 6 July 1994:  wref.c: protect with #ifdef GOOD_SPRINTF_EXPONENT an
+		 optimization that requires exponents to have 2 digits
+		 when 2 digits suffice.
+		 lwrite.c wsfe.c (list and formatted external output):
+		 omit ' ' carriage-control when compiled with
+		 -DOMIT_BLANK_CC .  Off-by-one bug fixed in character
+		 count for list output of character strings.
+		 Omit '.' in list-directed printing of Nan, Infinity. */
+/* 12 July 1994: wrtfmt.c: under G11.4, write 0. as "  .0000    " rather
+		 than "  .0000E+00". */
+/* 3 Aug. 1994:  lwrite.c: do not insert a newline when appending an
+		 oversize item to an empty line. */
+/* 12 Aug. 1994: rsli.c rsne.c: fix glitch (reset nml_read) that kept
+		 ERR= (in list- or format-directed input) from working
+		 after a NAMELIST READ. */
+/* 7 Sept. 1994: typesize.c: adjust to allow types LOGICAL*1, LOGICAL*2,
+		 INTEGER*1, and (under -DAllow_TYQUAD) INTEGER*8
+		 in NAMELISTs. */
+/* 6 Oct. 1994:  util.c: omit f__mvgbt, as it is never used. */
+/* 2 Nov. 1994:  add #ifdef ALWAYS_FLUSH logic. */
+/* 26 Jan. 1995: wref.c: fix glitch in printing the exponent of 0 when
+		 GOOD_SPRINTF_EXPONENT is not #defined. */
+/* 24 Feb. 1995: iio.c: z_getc: insert (unsigned char *) to allow
+		 internal reading of characters with high-bit set
+		 (on machines that sign-extend characters). */
+/* 14 March 1995:lread.c and rsfe.c: adjust s_rsle and s_rsfe to
+		 check for end-of-file (to prevent infinite loops
+		 with empty read statements). */
+/* 26 May 1995:  iio.c: z_wnew: fix bug in handling T format items
+		 in internal writes whose last item is written to
+		 an earlier position than some previous item. */
+/* 29 Aug. 1995: backspace.c: adjust MSDOS logic. */
+/* 6 Sept. 1995: Adjust namelist input to treat a subscripted name
+		 whose subscripts do not involve colons similarly
+		 to the name without a subscript: accept several
+		 values, stored in successive elements starting at
+		 the indicated subscript.  Adjust namelist output
+		 to quote character strings (avoiding confusion with
+		 arrays of character strings).  Adjust f_init calls
+		 for people who don't use libF77's main(); now open and
+		 namelist read statements invoke f_init if needed. */
+/* 7 Sept. 1995: Fix some bugs with -DAllow_TYQUAD (for integer*8).
+		 Add -DNo_Namelist_Comments lines to rsne.c. */
+/* 5 Oct. 1995:  wrtfmt.c: fix bug with t editing (f__cursor was not
+		 always zeroed in mv_cur). */
+/* 11 Oct. 1995: move defs of f__hiwater, f__svic, f__icptr from wrtfmt.c
+		 to err.c */
+/* 15 Mar. 1996: lread.c, rsfe.c: honor END= in READ stmt with empty iolist */
+
+/* 13 May 1996:  add ftell_.c and fseek_.c */
+/* 9 June 1996:  Adjust rsli.c and lread.c so internal list input with
+		 too few items in the input string will honor end= . */
+/* 12 Sept. 1995:fmtlib.c: fix glitch in printing the most negative integer. */
+/* 25 Sept. 1995:fmt.h: for formatted writes of negative integer*1 values,
+		 make ic signed on ANSI systems.  If formatted writes of
+		 integer*1 values trouble you when using a K&R C compiler,
+		 switch to an ANSI compiler or use a compiler flag that
+		 makes characters signed. */
+/* 9 Dec. 1996:	 d[fu]e.c, err.c: complain about non-positive rec=
+		 in direct read and write statements.
+		 ftell_.c: change param "unit" to "Unit" for -DKR_headers. */
+/* 26 Feb. 1997: ftell_.c: on systems that define SEEK_SET, etc., use
+		 SEEK_SET, SEEK_CUR, SEEK_END for *whence = 0, 1, 2. */
+/* 7 Apr. 1997:	 fmt.c: adjust to complain at missing numbers in formats
+		 (but still treat missing ".nnn" as ".0"). */
+/* 11 Apr. 1997: err.c: attempt to make stderr line buffered rather
+		 than fully buffered.  (Buffering is needed for format
+		 items T and TR.) */
+/* 27 May 1997:  ftell_.c: fix typo (that caused the third argument to be
+		 treated as 2 on some systems). */
+/* 5 Aug. 1997:  lread.c: adjust to accord with a change to the Fortran 8X
+		 draft (in 1990 or 1991) that rescinded permission to elide
+		 quote marks in namelist input of character data; compile
+		 with -DF8X_NML_ELIDE_QUOTES to get the old behavior.
+		 wrtfmt.o: wrt_G: tweak to print the right number of 0's
+		 for zero under G format. */
+/* 17 June 1997: detect recursive I/O and call f__fatal explaining it. */
+
+#include <stdio.h>
+
+void
+g77__ivers__ ()
+{
+  fprintf (stderr, "__G77_LIBI77_VERSION__: %s", __G77_LIBI77_VERSION__);
+  fputs (junk, stderr);
+}
diff --git a/gcc/f/runtime/libI77/backspace.c b/gcc/f/runtime/libI77/backspace.c
new file mode 100644
index 00000000000..8413d5f6821
--- /dev/null
+++ b/gcc/f/runtime/libI77/backspace.c
@@ -0,0 +1,101 @@
+#include <sys/types.h>
+#include "f2c.h"
+#include "fio.h"
+#ifdef KR_headers
+integer f_back(a) alist *a;
+#else
+integer f_back(alist *a)
+#endif
+{	unit *b;
+	int i, n, ndec;
+#if defined (MSDOS) && !defined (GO32)
+	int j, k;
+	long w, z;
+#endif
+	long x, y;
+	char buf[32];
+	if (f__init & 2)
+		f__fatal (131, "I/O recursion");
+	if(a->aunit >= MXUNIT || a->aunit < 0)
+		err(a->aerr,101,"backspace");
+	b= &f__units[a->aunit];
+	if(b->useek==0) err(a->aerr,106,"backspace");
+	if(b->ufd==NULL) {
+		fk_open(1, 1, a->aunit);
+		return(0);
+		}
+	if(b->uend==1)
+	{	b->uend=0;
+		return(0);
+	}
+	if(b->uwrt) {
+		(void) t_runc(a);
+		if (f__nowreading(b))
+			err(a->aerr,errno,"backspace");
+		}
+	if(b->url>0)
+	{
+		x=ftell(b->ufd);
+		y = x % b->url;
+		if(y == 0) x--;
+		x /= b->url;
+		x *= b->url;
+		(void) fseek(b->ufd,x,SEEK_SET);
+		return(0);
+	}
+
+	if(b->ufmt==0)
+	{	(void) fseek(b->ufd,-(long)sizeof(int),SEEK_CUR);
+		(void) fread((char *)&n,sizeof(int),1,b->ufd);
+		(void) fseek(b->ufd,-(long)n-2*sizeof(int),SEEK_CUR);
+		return(0);
+	}
+#if defined (MSDOS) && !defined (GO32)
+	w = -1;
+#endif
+	for(ndec = 1;; ndec = 0)
+	{
+		y = x = ftell(b->ufd);
+		if(x < sizeof(buf))
+			x = 0;
+		else
+			x -= sizeof(buf);
+		(void) fseek(b->ufd,x,SEEK_SET);
+		n=fread(buf,1,(size_t)(y-x), b->ufd);
+		for(i = n - ndec; --i >= 0; )
+		{
+			if(buf[i]!='\n') continue;
+#if defined (MSDOS) && !defined (GO32)
+			for(j = k = 0; j <= i; j++)
+				if (buf[j] == '\n')
+					k++;
+			fseek(b->ufd,x,SEEK_SET);
+			for(;;)
+				if (getc(b->ufd) == '\n') {
+					if ((z = ftell(b->ufd)) >= y && ndec) {
+						if (w == -1)
+							goto break2;
+						break;
+						}
+					if (--k <= 0)
+						return 0;
+					w = z;
+					}
+			fseek(b->ufd, w, SEEK_SET);
+#else
+			fseek(b->ufd,(long)(i+1-n),SEEK_CUR);
+#endif
+			return(0);
+		}
+#if defined (MSDOS) && !defined (GO32)
+ break2:
+#endif
+		if(x==0)
+			{
+			(void) fseek(b->ufd, 0L, SEEK_SET);
+			return(0);
+			}
+		else if(n<=0) err(a->aerr,(EOF),"backspace");
+		(void) fseek(b->ufd, x, SEEK_SET);
+	}
+}
diff --git a/gcc/f/runtime/libI77/close.c b/gcc/f/runtime/libI77/close.c
new file mode 100644
index 00000000000..40e15c175f4
--- /dev/null
+++ b/gcc/f/runtime/libI77/close.c
@@ -0,0 +1,99 @@
+#include "f2c.h"
+#include "fio.h"
+#ifdef KR_headers
+integer f_clos(a) cllist *a;
+#else
+#undef abs
+#undef min
+#undef max
+#include <stdlib.h>
+#ifdef NON_UNIX_STDIO
+#ifndef unlink
+#define unlink remove
+#endif
+#else
+#if defined (MSDOS) && !defined (GO32)
+#include "io.h"
+#else
+#ifdef __cplusplus
+extern "C" int unlink(const char*);
+#else
+extern int unlink(const char*);
+#endif
+#endif
+#endif
+
+integer f_clos(cllist *a)
+#endif
+{	unit *b;
+
+	if (f__init & 2)
+		f__fatal (131, "I/O recursion");
+	if(a->cunit >= MXUNIT) return(0);
+	b= &f__units[a->cunit];
+	if(b->ufd==NULL)
+		goto done;
+	if (!a->csta)
+		if (b->uscrtch == 1)
+			goto Delete;
+		else
+			goto Keep;
+	switch(*a->csta) {
+		default:
+	 	Keep:
+		case 'k':
+		case 'K':
+			if(b->uwrt == 1)
+				t_runc((alist *)a);
+			if(b->ufnm) {
+				fclose(b->ufd);
+				free(b->ufnm);
+				}
+			break;
+		case 'd':
+		case 'D':
+		Delete:
+			if(b->ufnm) {
+				fclose(b->ufd);
+				unlink(b->ufnm); /*SYSDEP*/
+				free(b->ufnm);
+				}
+		}
+	b->ufd=NULL;
+ done:
+	b->uend=0;
+	b->ufnm=NULL;
+	return(0);
+	}
+ void
+#ifdef KR_headers
+f_exit()
+#else
+f_exit(void)
+#endif
+{	int i;
+	static cllist xx;
+	if (f__init & 1)
+		return;		/* Not initialized, so no open units. */
+	if (!xx.cerr) {
+		xx.cerr=1;
+		xx.csta=NULL;
+		for(i=0;i<MXUNIT;i++)
+		{
+			xx.cunit=i;
+			(void) f_clos(&xx);
+		}
+	}
+}
+ int
+#ifdef KR_headers
+G77_flush_0 ()
+#else
+G77_flush_0 (void)
+#endif
+{	int i;
+	for(i=0;i<MXUNIT;i++)
+		if(f__units[i].ufd != NULL && f__units[i].uwrt)
+			fflush(f__units[i].ufd);
+return 0;
+}
diff --git a/gcc/f/runtime/libI77/dfe.c b/gcc/f/runtime/libI77/dfe.c
new file mode 100644
index 00000000000..e229e0e3356
--- /dev/null
+++ b/gcc/f/runtime/libI77/dfe.c
@@ -0,0 +1,156 @@
+#include "f2c.h"
+#include "fio.h"
+#include "fmt.h"
+
+y_rsk(Void)
+{
+	if(f__curunit->uend || f__curunit->url <= f__recpos
+		|| f__curunit->url == 1) return 0;
+	do {
+		getc(f__cf);
+	} while(++f__recpos < f__curunit->url);
+	return 0;
+}
+y_getc(Void)
+{
+	int ch;
+	if(f__curunit->uend) return(-1);
+	if((ch=getc(f__cf))!=EOF)
+	{
+		f__recpos++;
+		if(f__curunit->url>=f__recpos ||
+			f__curunit->url==1)
+			return(ch);
+		else	return(' ');
+	}
+	if(feof(f__cf))
+	{
+		f__curunit->uend=1;
+		errno=0;
+		return(-1);
+	}
+	err(f__elist->cierr,errno,"readingd");
+}
+#ifdef KR_headers
+y_putc(c)
+#else
+y_putc(int c)
+#endif
+{
+	f__recpos++;
+	if(f__recpos <= f__curunit->url || f__curunit->url==1)
+		putc(c,f__cf);
+	else
+		err(f__elist->cierr,110,"dout");
+	return(0);
+}
+y_rev(Void)
+{	/*what about work done?*/
+	if(f__curunit->url==1 || f__recpos==f__curunit->url)
+		return(0);
+	while(f__recpos<f__curunit->url)
+		(*f__putn)(' ');
+	f__recpos=0;
+	return(0);
+}
+y_err(Void)
+{
+	err(f__elist->cierr, 110, "dfe");
+}
+
+y_newrec(Void)
+{
+	if(f__curunit->url == 1 || f__recpos == f__curunit->url) {
+		f__hiwater = f__recpos = f__cursor = 0;
+		return(1);
+	}
+	if(f__hiwater > f__recpos)
+		f__recpos = f__hiwater;
+	y_rev();
+	f__hiwater = f__cursor = 0;
+	return(1);
+}
+
+#ifdef KR_headers
+c_dfe(a) cilist *a;
+#else
+c_dfe(cilist *a)
+#endif
+{
+	f__sequential=0;
+	f__formatted=f__external=1;
+	f__elist=a;
+	f__cursor=f__scale=f__recpos=0;
+	if(a->ciunit>MXUNIT || a->ciunit<0)
+		err(a->cierr,101,"startchk");
+	f__curunit = &f__units[a->ciunit];
+	if(f__curunit->ufd==NULL && fk_open(DIR,FMT,a->ciunit))
+		err(a->cierr,104,"dfe");
+	f__cf=f__curunit->ufd;
+	if(!f__curunit->ufmt) err(a->cierr,102,"dfe");
+	if(!f__curunit->useek) err(a->cierr,104,"dfe");
+	f__fmtbuf=a->cifmt;
+	if(a->cirec <= 0)
+		err(a->cierr,130,"dfe");
+	(void) fseek(f__cf,(long)f__curunit->url * (a->cirec-1),SEEK_SET);
+	f__curunit->uend = 0;
+	return(0);
+}
+#ifdef KR_headers
+integer s_rdfe(a) cilist *a;
+#else
+integer s_rdfe(cilist *a)
+#endif
+{
+	int n;
+	if(f__init != 1) f_init();
+	f__init = 3;
+	f__reading=1;
+	if(n=c_dfe(a))return(n);
+	if(f__curunit->uwrt && f__nowreading(f__curunit))
+		err(a->cierr,errno,"read start");
+	f__getn = y_getc;
+	f__doed = rd_ed;
+	f__doned = rd_ned;
+	f__dorevert = f__donewrec = y_err;
+	f__doend = y_rsk;
+	if(pars_f(f__fmtbuf)<0)
+		err(a->cierr,100,"read start");
+	fmt_bg();
+	return(0);
+}
+#ifdef KR_headers
+integer s_wdfe(a) cilist *a;
+#else
+integer s_wdfe(cilist *a)
+#endif
+{
+	int n;
+	if(f__init != 1) f_init();
+	f__init = 3;
+	f__reading=0;
+	if(n=c_dfe(a)) return(n);
+	if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit))
+		err(a->cierr,errno,"startwrt");
+	f__putn = y_putc;
+	f__doed = w_ed;
+	f__doned= w_ned;
+	f__dorevert = y_err;
+	f__donewrec = y_newrec;
+	f__doend = y_rev;
+	if(pars_f(f__fmtbuf)<0)
+		err(a->cierr,100,"startwrt");
+	fmt_bg();
+	return(0);
+}
+integer e_rdfe(Void)
+{
+	f__init = 1;
+	(void) en_fio();
+	return(0);
+}
+integer e_wdfe(Void)
+{
+	f__init = 1;
+	return en_fio();
+}
diff --git a/gcc/f/runtime/libI77/dolio.c b/gcc/f/runtime/libI77/dolio.c
new file mode 100644
index 00000000000..4b5a2ca6588
--- /dev/null
+++ b/gcc/f/runtime/libI77/dolio.c
@@ -0,0 +1,20 @@
+#include "f2c.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+#ifdef KR_headers
+extern int (*f__lioproc)();
+
+integer do_lio(type,number,ptr,len) ftnint *number,*type; char *ptr; ftnlen len;
+#else
+extern int (*f__lioproc)(ftnint*, char*, ftnlen, ftnint);
+
+integer do_lio(ftnint *type, ftnint *number, char *ptr, ftnlen len)
+#endif
+{
+	return((*f__lioproc)(number,ptr,len,*type));
+}
+#ifdef __cplusplus
+	}
+#endif
diff --git a/gcc/f/runtime/libI77/due.c b/gcc/f/runtime/libI77/due.c
new file mode 100644
index 00000000000..dec58657b50
--- /dev/null
+++ b/gcc/f/runtime/libI77/due.c
@@ -0,0 +1,73 @@
+#include "f2c.h"
+#include "fio.h"
+
+#ifdef KR_headers
+c_due(a) cilist *a;
+#else
+c_due(cilist *a)
+#endif
+{
+	if(f__init != 1) f_init();
+	f__init = 3;
+	if(a->ciunit>=MXUNIT || a->ciunit<0)
+		err(a->cierr,101,"startio");
+	f__sequential=f__formatted=f__recpos=0;
+	f__external=1;
+	f__curunit = &f__units[a->ciunit];
+	f__elist=a;
+	if(f__curunit->ufd==NULL && fk_open(DIR,UNF,a->ciunit) ) err(a->cierr,104,"due");
+	f__cf=f__curunit->ufd;
+	if(f__curunit->ufmt) err(a->cierr,102,"cdue");
+	if(!f__curunit->useek) err(a->cierr,104,"cdue");
+	if(f__curunit->ufd==NULL) err(a->cierr,114,"cdue");
+	if(a->cirec <= 0)
+		err(a->cierr,130,"due");
+	(void) fseek(f__cf,(long)(a->cirec-1)*f__curunit->url,SEEK_SET);
+	f__curunit->uend = 0;
+	return(0);
+}
+#ifdef KR_headers
+integer s_rdue(a) cilist *a;
+#else
+integer s_rdue(cilist *a)
+#endif
+{
+	int n;
+	f__reading=1;
+	if(n=c_due(a)) return(n);
+	if(f__curunit->uwrt && f__nowreading(f__curunit))
+		err(a->cierr,errno,"read start");
+	return(0);
+}
+#ifdef KR_headers
+integer s_wdue(a) cilist *a;
+#else
+integer s_wdue(cilist *a)
+#endif
+{
+	int n;
+	f__reading=0;
+	if(n=c_due(a)) return(n);
+	if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit))
+		err(a->cierr,errno,"write start");
+	return(0);
+}
+integer e_rdue(Void)
+{
+	f__init = 1;
+	if(f__curunit->url==1 || f__recpos==f__curunit->url)
+		return(0);
+	(void) fseek(f__cf,(long)(f__curunit->url-f__recpos),SEEK_CUR);
+	if(ftell(f__cf)%f__curunit->url)
+		err(f__elist->cierr,200,"syserr");
+	return(0);
+}
+integer e_wdue(Void)
+{
+	f__init = 1;
+#ifdef ALWAYS_FLUSH
+	if (fflush(f__cf))
+		err(f__elist->cierr,errno,"write end");
+#endif
+	return(e_rdue());
+}
diff --git a/gcc/f/runtime/libI77/endfile.c b/gcc/f/runtime/libI77/endfile.c
new file mode 100644
index 00000000000..6050d1e3b30
--- /dev/null
+++ b/gcc/f/runtime/libI77/endfile.c
@@ -0,0 +1,195 @@
+#include "f2c.h"
+#include "fio.h"
+#include <sys/types.h>
+#include "rawio.h"
+
+#ifdef KR_headers
+extern char *strcpy();
+#else
+#undef abs
+#undef min
+#undef max
+#include <stdlib.h>
+#include <string.h>
+#endif
+
+#ifdef NON_UNIX_STDIO
+#ifndef unlink
+#define unlink remove
+#endif
+#else
+#if defined (MSDOS) && !defined (GO32)
+#include "io.h"
+#endif
+#endif
+
+#ifdef NON_UNIX_STDIO
+extern char *f__r_mode[], *f__w_mode[];
+#endif
+
+#ifdef KR_headers
+integer f_end(a) alist *a;
+#else
+integer f_end(alist *a)
+#endif
+{
+	unit *b;
+	if (f__init & 2)
+		f__fatal (131, "I/O recursion");
+	if(a->aunit>=MXUNIT || a->aunit<0) err(a->aerr,101,"endfile");
+	b = &f__units[a->aunit];
+	if(b->ufd==NULL) {
+		char nbuf[10];
+		(void) sprintf(nbuf,"fort.%ld",a->aunit);
+#ifdef NON_UNIX_STDIO
+		{ FILE *tf;
+			if (tf = fopen(nbuf, f__w_mode[0]))
+				fclose(tf);
+			}
+#else
+		close(creat(nbuf, 0666));
+#endif
+		return(0);
+		}
+	b->uend=1;
+	return(b->useek ? t_runc(a) : 0);
+}
+
+ static int
+#ifdef NON_UNIX_STDIO
+#ifdef KR_headers
+copy(from, len, to) char *from, *to; register long len;
+#else
+copy(FILE *from, register long len, FILE *to)
+#endif
+{
+	int k, len1;
+	char buf[BUFSIZ];
+
+	while(fread(buf, len1 = len > BUFSIZ ? BUFSIZ : (int)len, 1, from)) {
+		if (!fwrite(buf, len1, 1, to))
+			return 1;
+		if ((len -= len1) <= 0)
+			break;
+		}
+	return 0;
+	}
+#else
+#ifdef KR_headers
+copy(from, len, to) char *from, *to; register long len;
+#else
+copy(char *from, register long len, char *to)
+#endif
+{
+	register size_t n;
+	int k, rc = 0, tmp;
+	char buf[BUFSIZ];
+
+	if ((k = open(from, O_RDONLY)) < 0)
+		return 1;
+	if ((tmp = creat(to,0666)) < 0)
+		return 1;
+	while((n = read(k, buf, (size_t) (len > BUFSIZ ? BUFSIZ : (int)len))) > 0) {
+		if (write(tmp, buf, n) != n)
+			{ rc = 1; break; }
+		if ((len -= n) <= 0)
+			break;
+		}
+	close(k);
+	close(tmp);
+	return n < 0 ? 1 : rc;
+	}
+#endif
+
+#ifndef L_tmpnam
+#define L_tmpnam 16
+#endif
+
+ int
+#ifdef KR_headers
+t_runc(a) alist *a;
+#else
+t_runc(alist *a)
+#endif
+{
+	char nm[L_tmpnam+12];	/* extra space in case L_tmpnam is tiny */
+	long loc, len;
+	unit *b;
+#ifdef NON_UNIX_STDIO
+	FILE *bf, *tf;
+#else
+	FILE *bf;
+#endif
+	int rc = 0;
+
+	b = &f__units[a->aunit];
+	if(b->url)
+		return(0);	/*don't truncate direct files*/
+	loc=ftell(bf = b->ufd);
+	fseek(bf,0L,SEEK_END);
+	len=ftell(bf);
+	if (loc >= len || b->useek == 0 || b->ufnm == NULL)
+		return(0);
+#ifdef NON_UNIX_STDIO
+	fclose(b->ufd);
+#else
+	rewind(b->ufd);	/* empty buffer */
+#endif
+	if (!loc) {
+#ifdef NON_UNIX_STDIO
+		if (!(bf = fopen(b->ufnm, f__w_mode[b->ufmt])))
+#else
+		if (close(creat(b->ufnm,0666)))
+#endif
+			rc = 1;
+		if (b->uwrt)
+			b->uwrt = 1;
+		goto done;
+		}
+#ifdef _POSIX_SOURCE
+	tmpnam(nm);
+#else
+	strcpy(nm,"tmp.FXXXXXX");
+	mktemp(nm);
+#endif
+#ifdef NON_UNIX_STDIO
+	if (!(bf = fopen(b->ufnm, f__r_mode[0]))) {
+ bad:
+		rc = 1;
+		goto done;
+		}
+	if (!(tf = fopen(nm, f__w_mode[0])))
+		goto bad;
+	if (copy(bf, loc, tf)) {
+ bad1:
+		rc = 1;
+		goto done1;
+		}
+	if (!(bf = freopen(b->ufnm, f__w_mode[0], bf)))
+		goto bad1;
+	if (!(tf = freopen(nm, f__r_mode[0], tf)))
+		goto bad1;
+	if (copy(tf, loc, bf))
+		goto bad1;
+	if (f__w_mode[0] != f__w_mode[b->ufmt]) {
+	 	if (!(bf = freopen(b->ufnm, f__w_mode[b->ufmt|2], bf)))
+			goto bad1;
+		fseek(bf, loc, SEEK_SET);
+		}
+done1:
+	fclose(tf);
+	unlink(nm);
+done:
+	f__cf = b->ufd = bf;
+#else
+	if (copy(b->ufnm, loc, nm)
+	 || copy(nm, loc, b->ufnm))
+		rc = 1;
+	unlink(nm);
+	fseek(b->ufd, loc, SEEK_SET);
+done:
+#endif
+	if (rc)
+		err(a->aerr,111,"endfile");
+	return 0;
+	}
diff --git a/gcc/f/runtime/libI77/err.c b/gcc/f/runtime/libI77/err.c
new file mode 100644
index 00000000000..1d0188737be
--- /dev/null
+++ b/gcc/f/runtime/libI77/err.c
@@ -0,0 +1,298 @@
+#ifndef NON_UNIX_STDIO
+#include <sys/types.h>
+#include <sys/stat.h>
+#endif
+#include "f2c.h"
+#if defined (NON_UNIX_STDIO) || defined (MISSING_FILE_ELEMS)
+#ifdef KR_headers
+extern char *malloc();
+#else
+#undef abs
+#undef min
+#undef max
+#include <stdlib.h>
+#endif
+#endif
+#include "fio.h"
+#include "fmt.h"	/* for struct syl */
+#include "rawio.h"	/* for fcntl.h, fdopen */
+
+/*global definitions*/
+unit f__units[MXUNIT];	/*unit table*/
+int f__init;	/*bit 0: set after initializations;
+		  bit 1: set during I/O involving returns to
+		    caller of library (or calls to user code)*/
+cilist *f__elist;	/*active external io list*/
+icilist *f__svic;	/*active internal io list*/
+flag f__reading;	/*1 if reading, 0 if writing*/
+flag f__cplus,f__cblank;
+char *f__fmtbuf;
+flag f__external;	/*1 if external io, 0 if internal */
+#ifdef KR_headers
+int (*f__doed)(),(*f__doned)();
+int (*f__doend)(),(*f__donewrec)(),(*f__dorevert)();
+int (*f__getn)(),(*f__putn)();	/*for formatted io*/
+#else
+int (*f__getn)(void),(*f__putn)(int);	/*for formatted io*/
+int (*f__doed)(struct syl*, char*, ftnlen),(*f__doned)(struct syl*);
+int (*f__dorevert)(void),(*f__donewrec)(void),(*f__doend)(void);
+#endif
+flag f__sequential;	/*1 if sequential io, 0 if direct*/
+flag f__formatted;	/*1 if formatted io, 0 if unformatted*/
+FILE *f__cf;	/*current file*/
+unit *f__curunit;	/*current unit*/
+int f__recpos;	/*place in current record*/
+int f__cursor, f__hiwater, f__scale;
+char *f__icptr;
+
+/*error messages*/
+char *F_err[] =
+{
+	"error in format",				/* 100 */
+	"illegal unit number",				/* 101 */
+	"formatted io not allowed",			/* 102 */
+	"unformatted io not allowed",			/* 103 */
+	"direct io not allowed",			/* 104 */
+	"sequential io not allowed",			/* 105 */
+	"can't backspace file",				/* 106 */
+	"null file name",				/* 107 */
+	"can't stat file",				/* 108 */
+	"unit not connected",				/* 109 */
+	"off end of record",				/* 110 */
+	"truncation failed in endfile",			/* 111 */
+	"incomprehensible list input",			/* 112 */
+	"out of free space",				/* 113 */
+	"unit not connected",				/* 114 */
+	"read unexpected character",			/* 115 */
+	"bad logical input field",			/* 116 */
+	"bad variable type",				/* 117 */
+	"bad namelist name",				/* 118 */
+	"variable not in namelist",			/* 119 */
+	"no end record",				/* 120 */
+	"variable count incorrect",			/* 121 */
+	"subscript for scalar variable",		/* 122 */
+	"invalid array section",			/* 123 */
+	"substring out of bounds",			/* 124 */
+	"subscript out of bounds",			/* 125 */
+	"can't read file",				/* 126 */
+	"can't write file",				/* 127 */
+	"'new' file exists",				/* 128 */
+	"can't append to file",				/* 129 */
+	"non-positive record number",			/* 130 */
+	"I/O started while already doing I/O"		/* 131 */
+};
+#define MAXERR (sizeof(F_err)/sizeof(char *)+100)
+
+#ifdef KR_headers
+f__canseek(f) FILE *f; /*SYSDEP*/
+#else
+f__canseek(FILE *f) /*SYSDEP*/
+#endif
+{
+#ifdef NON_UNIX_STDIO
+	return !isatty(fileno(f));
+#else
+	struct stat x;
+
+	if (fstat(fileno(f),&x) < 0)
+		return(0);
+#ifdef S_IFMT
+	switch(x.st_mode & S_IFMT) {
+	case S_IFDIR:
+	case S_IFREG:
+		if(x.st_nlink > 0)	/* !pipe */
+			return(1);
+		else
+			return(0);
+	case S_IFCHR:
+		if(isatty(fileno(f)))
+			return(0);
+		return(1);
+#ifdef S_IFBLK
+	case S_IFBLK:
+		return(1);
+#endif
+	}
+#else
+#ifdef S_ISDIR
+	/* POSIX version */
+	if (S_ISREG(x.st_mode) || S_ISDIR(x.st_mode)) {
+		if(x.st_nlink > 0)	/* !pipe */
+			return(1);
+		else
+			return(0);
+		}
+	if (S_ISCHR(x.st_mode)) {
+		if(isatty(fileno(f)))
+			return(0);
+		return(1);
+		}
+	if (S_ISBLK(x.st_mode))
+		return(1);
+#else
+	Help! How does fstat work on this system?
+#endif
+#endif
+	return(0);	/* who knows what it is? */
+#endif
+}
+
+ void
+#ifdef KR_headers
+f__fatal(n,s) char *s;
+#else
+f__fatal(int n, char *s)
+#endif
+{
+	static int dead = 0;
+
+	if(n<100 && n>=0) perror(s); /*SYSDEP*/
+	else if(n >= (int)MAXERR || n < -1)
+	{	fprintf(stderr,"%s: illegal error number %d\n",s,n);
+	}
+	else if(n == -1) fprintf(stderr,"%s: end of file\n",s);
+	else
+		fprintf(stderr,"%s: %s\n",s,F_err[n-100]);
+	if (dead) {
+		fprintf (stderr, "(libf2c f__fatal already called, aborting.)");
+		abort();
+	}
+	dead = 1;
+	if (f__init & 1) {
+		if (f__curunit) {
+			fprintf(stderr,"apparent state: unit %d ",f__curunit-f__units);
+			fprintf(stderr, f__curunit->ufnm ? "named %s\n" : "(unnamed)\n",
+				f__curunit->ufnm);
+			}
+		else
+			fprintf(stderr,"apparent state: internal I/O\n");
+		if (f__fmtbuf)
+			fprintf(stderr,"last format: %s\n",f__fmtbuf);
+		fprintf(stderr,"lately %s %s %s %s",f__reading?"reading":"writing",
+			f__sequential?"sequential":"direct",f__formatted?"formatted":"unformatted",
+			f__external?"external":"internal");
+	}
+	f__init &= ~2;	/* No longer doing I/O (no more user code to be called). */
+	sig_die(" IO", 1);
+}
+/*initialization routine*/
+ VOID
+f_init(Void)
+{	unit *p;
+
+	if (f__init & 2)
+		f__fatal (131, "I/O recursion");
+	f__init = 1;
+	p= &f__units[0];
+	p->ufd=stderr;
+	p->useek=f__canseek(stderr);
+#ifdef _IOLBF
+	setvbuf(stderr, (char*)malloc(BUFSIZ+8), _IOLBF, BUFSIZ+8);
+#else
+#if defined (NON_UNIX_STDIO) || defined (MISSING_FILE_ELEMS)
+	setbuf(stderr, (char *)malloc(BUFSIZ+8));
+#else
+	stderr->_flag &= ~_IONBF;
+#endif
+#endif
+	p->ufmt=1;
+	p->uwrt=1;
+	p = &f__units[5];
+	p->ufd=stdin;
+	p->useek=f__canseek(stdin);
+	p->ufmt=1;
+	p->uwrt=0;
+	p= &f__units[6];
+	p->ufd=stdout;
+	p->useek=f__canseek(stdout);
+	p->ufmt=1;
+	p->uwrt=1;
+}
+#ifdef KR_headers
+f__nowreading(x) unit *x;
+#else
+f__nowreading(unit *x)
+#endif
+{
+	long loc;
+	int ufmt;
+	extern char *f__r_mode[];
+
+	if (!x->ufnm)
+		goto cantread;
+	ufmt = x->ufmt;
+	loc=ftell(x->ufd);
+	if(freopen(x->ufnm,f__r_mode[ufmt],x->ufd) == NULL) {
+ cantread:
+		errno = 126;
+		return(1);
+		}
+	x->uwrt=0;
+	(void) fseek(x->ufd,loc,SEEK_SET);
+	return(0);
+}
+#ifdef KR_headers
+f__nowwriting(x) unit *x;
+#else
+f__nowwriting(unit *x)
+#endif
+{
+	long loc;
+	int ufmt;
+	extern char *f__w_mode[];
+#ifndef NON_UNIX_STDIO
+	int k;
+#endif
+
+	if (!x->ufnm)
+		goto cantwrite;
+	ufmt = x->ufmt;
+#ifdef NON_UNIX_STDIO
+	ufmt |= 2;
+#endif
+	if (x->uwrt == 3) { /* just did write, rewind */
+#ifdef NON_UNIX_STDIO
+		if (!(f__cf = x->ufd =
+				freopen(x->ufnm,f__w_mode[ufmt],x->ufd)))
+#else
+		if (close(creat(x->ufnm,0666)))
+#endif
+			goto cantwrite;
+		}
+	else {
+		loc=ftell(x->ufd);
+#ifdef NON_UNIX_STDIO
+		if (!(f__cf = x->ufd =
+			freopen(x->ufnm, f__w_mode[ufmt], x->ufd)))
+#else
+		if (fclose(x->ufd) < 0
+		|| (k = x->uwrt == 2 ? creat(x->ufnm,0666)
+				     : open(x->ufnm,O_WRONLY)) < 0
+		|| (f__cf = x->ufd = fdopen(k,f__w_mode[ufmt])) == NULL)
+#endif
+			{
+			x->ufd = NULL;
+ cantwrite:
+			errno = 127;
+			return(1);
+			}
+		(void) fseek(x->ufd,loc,SEEK_SET);
+		}
+	x->uwrt = 1;
+	return(0);
+}
+
+ int
+#ifdef KR_headers
+err__fl(f, m, s) int f, m; char *s;
+#else
+err__fl(int f, int m, char *s)
+#endif
+{
+	if (!f)
+		f__fatal(m, s);
+	if (f__doend)
+		(*f__doend)();
+	f__init &= ~2;
+	return errno = m;
+	}
diff --git a/gcc/f/runtime/libI77/f2ch.add b/gcc/f/runtime/libI77/f2ch.add
new file mode 100644
index 00000000000..a2acc17a159
--- /dev/null
+++ b/gcc/f/runtime/libI77/f2ch.add
@@ -0,0 +1,162 @@
+/* If you are using a C++ compiler, append the following to f2c.h
+   for compiling libF77 and libI77. */
+
+#ifdef __cplusplus
+extern "C" {
+extern int abort_(void);
+extern double c_abs(complex *);
+extern void c_cos(complex *, complex *);
+extern void c_div(complex *, complex *, complex *);
+extern void c_exp(complex *, complex *);
+extern void c_log(complex *, complex *);
+extern void c_sin(complex *, complex *);
+extern void c_sqrt(complex *, complex *);
+extern double d_abs(double *);
+extern double d_acos(double *);
+extern double d_asin(double *);
+extern double d_atan(double *);
+extern double d_atn2(double *, double *);
+extern void d_cnjg(doublecomplex *, doublecomplex *);
+extern double d_cos(double *);
+extern double d_cosh(double *);
+extern double d_dim(double *, double *);
+extern double d_exp(double *);
+extern double d_imag(doublecomplex *);
+extern double d_int(double *);
+extern double d_lg10(double *);
+extern double d_log(double *);
+extern double d_mod(double *, double *);
+extern double d_nint(double *);
+extern double d_prod(float *, float *);
+extern double d_sign(double *, double *);
+extern double d_sin(double *);
+extern double d_sinh(double *);
+extern double d_sqrt(double *);
+extern double d_tan(double *);
+extern double d_tanh(double *);
+extern double derf_(double *);
+extern double derfc_(double *);
+extern integer do_fio(ftnint *, char *, ftnlen);
+extern integer do_lio(ftnint *, ftnint *, char *, ftnlen);
+extern integer do_uio(ftnint *, char *, ftnlen);
+extern integer e_rdfe(void);
+extern integer e_rdue(void);
+extern integer e_rsfe(void);
+extern integer e_rsfi(void);
+extern integer e_rsle(void);
+extern integer e_rsli(void);
+extern integer e_rsue(void);
+extern integer e_wdfe(void);
+extern integer e_wdue(void);
+extern integer e_wsfe(void);
+extern integer e_wsfi(void);
+extern integer e_wsle(void);
+extern integer e_wsli(void);
+extern integer e_wsue(void);
+extern int ef1asc_(ftnint *, ftnlen *, ftnint *, ftnlen *);
+extern integer ef1cmc_(ftnint *, ftnlen *, ftnint *, ftnlen *);
+extern double erf(double);
+extern double erf_(float *);
+extern double erfc(double);
+extern double erfc_(float *);
+extern integer f_back(alist *);
+extern integer f_clos(cllist *);
+extern integer f_end(alist *);
+extern void f_exit(void);
+extern integer f_inqu(inlist *);
+extern integer f_open(olist *);
+extern integer f_rew(alist *);
+extern int flush_(void);
+extern void getarg_(integer *, char *, ftnlen);
+extern void getenv_(char *, char *, ftnlen, ftnlen);
+extern short h_abs(short *);
+extern short h_dim(short *, short *);
+extern short h_dnnt(double *);
+extern short h_indx(char *, char *, ftnlen, ftnlen);
+extern short h_len(char *, ftnlen);
+extern short h_mod(short *, short *);
+extern short h_nint(float *);
+extern short h_sign(short *, short *);
+extern short hl_ge(char *, char *, ftnlen, ftnlen);
+extern short hl_gt(char *, char *, ftnlen, ftnlen);
+extern short hl_le(char *, char *, ftnlen, ftnlen);
+extern short hl_lt(char *, char *, ftnlen, ftnlen);
+extern integer i_abs(integer *);
+extern integer i_dim(integer *, integer *);
+extern integer i_dnnt(double *);
+extern integer i_indx(char *, char *, ftnlen, ftnlen);
+extern integer i_len(char *, ftnlen);
+extern integer i_mod(integer *, integer *);
+extern integer i_nint(float *);
+extern integer i_sign(integer *, integer *);
+extern integer iargc_(void);
+extern ftnlen l_ge(char *, char *, ftnlen, ftnlen);
+extern ftnlen l_gt(char *, char *, ftnlen, ftnlen);
+extern ftnlen l_le(char *, char *, ftnlen, ftnlen);
+extern ftnlen l_lt(char *, char *, ftnlen, ftnlen);
+extern void pow_ci(complex *, complex *, integer *);
+extern double pow_dd(double *, double *);
+extern double pow_di(double *, integer *);
+extern short pow_hh(short *, shortint *);
+extern integer pow_ii(integer *, integer *);
+extern double pow_ri(float *, integer *);
+extern void pow_zi(doublecomplex *, doublecomplex *, integer *);
+extern void pow_zz(doublecomplex *, doublecomplex *, doublecomplex *);
+extern double r_abs(float *);
+extern double r_acos(float *);
+extern double r_asin(float *);
+extern double r_atan(float *);
+extern double r_atn2(float *, float *);
+extern void r_cnjg(complex *, complex *);
+extern double r_cos(float *);
+extern double r_cosh(float *);
+extern double r_dim(float *, float *);
+extern double r_exp(float *);
+extern double r_imag(complex *);
+extern double r_int(float *);
+extern double r_lg10(float *);
+extern double r_log(float *);
+extern double r_mod(float *, float *);
+extern double r_nint(float *);
+extern double r_sign(float *, float *);
+extern double r_sin(float *);
+extern double r_sinh(float *);
+extern double r_sqrt(float *);
+extern double r_tan(float *);
+extern double r_tanh(float *);
+extern void s_cat(char *, char **, integer *, integer *, ftnlen);
+extern integer s_cmp(char *, char *, ftnlen, ftnlen);
+extern void s_copy(char *, char *, ftnlen, ftnlen);
+extern int s_paus(char *, ftnlen);
+extern integer s_rdfe(cilist *);
+extern integer s_rdue(cilist *);
+extern integer s_rnge(char *, integer, char *, integer);
+extern integer s_rsfe(cilist *);
+extern integer s_rsfi(icilist *);
+extern integer s_rsle(cilist *);
+extern integer s_rsli(icilist *);
+extern integer s_rsne(cilist *);
+extern integer s_rsni(icilist *);
+extern integer s_rsue(cilist *);
+extern int s_stop(char *, ftnlen);
+extern integer s_wdfe(cilist *);
+extern integer s_wdue(cilist *);
+extern integer s_wsfe(cilist *);
+extern integer s_wsfi(icilist *);
+extern integer s_wsle(cilist *);
+extern integer s_wsli(icilist *);
+extern integer s_wsne(cilist *);
+extern integer s_wsni(icilist *);
+extern integer s_wsue(cilist *);
+extern void sig_die(char *, int);
+extern integer signal_(integer *, void (*)(int));
+extern integer system_(char *, ftnlen);
+extern double z_abs(doublecomplex *);
+extern void z_cos(doublecomplex *, doublecomplex *);
+extern void z_div(doublecomplex *, doublecomplex *, doublecomplex *);
+extern void z_exp(doublecomplex *, doublecomplex *);
+extern void z_log(doublecomplex *, doublecomplex *);
+extern void z_sin(doublecomplex *, doublecomplex *);
+extern void z_sqrt(doublecomplex *, doublecomplex *);
+	}
+#endif
diff --git a/gcc/f/runtime/libI77/fio.h b/gcc/f/runtime/libI77/fio.h
new file mode 100644
index 00000000000..769d360a626
--- /dev/null
+++ b/gcc/f/runtime/libI77/fio.h
@@ -0,0 +1,102 @@
+#include <stdio.h>
+#include <errno.h>
+#ifndef NULL
+/* ANSI C */
+#include <stddef.h>
+#endif
+
+#ifndef SEEK_SET
+#define SEEK_SET 0
+#define SEEK_CUR 1
+#define SEEK_END 2
+#endif
+
+#if defined (MSDOS) && !defined (GO32)
+#ifndef NON_UNIX_STDIO
+#define NON_UNIX_STDIO
+#endif
+#endif
+
+#ifdef UIOLEN_int
+typedef int uiolen;
+#else
+typedef long uiolen;
+#endif
+
+/*units*/
+typedef struct
+{	FILE *ufd;	/*0=unconnected*/
+	char *ufnm;
+#if !(defined (MSDOS) && !defined (GO32))
+	long uinode;
+	int udev;
+#endif
+	int url;	/*0=sequential*/
+	flag useek;	/*true=can backspace, use dir, ...*/
+	flag ufmt;
+	flag uprnt;
+	flag ublnk;
+	flag uend;
+	flag uwrt;	/*last io was write*/
+	flag uscrtch;
+} unit;
+
+extern int f__init;
+extern cilist *f__elist;	/*active external io list*/
+extern flag f__reading,f__external,f__sequential,f__formatted;
+#undef Void
+#ifdef KR_headers
+#define Void /*void*/
+extern int (*f__getn)(),(*f__putn)();	/*for formatted io*/
+extern long f__inode();
+extern VOID sig_die();
+extern int (*f__donewrec)(), t_putc(), x_wSL();
+extern int c_sfe(), err__fl(), xrd_SL();
+#else
+#define Void void
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern int (*f__getn)(void),(*f__putn)(int);	/*for formatted io*/
+extern long f__inode(char*,int*);
+extern void sig_die(char*,int);
+extern void f__fatal(int,char*);
+extern int t_runc(alist*);
+extern int f__nowreading(unit*), f__nowwriting(unit*);
+extern int fk_open(int,int,ftnint);
+extern int en_fio(void);
+extern void f_init(void);
+extern int (*f__donewrec)(void), t_putc(int), x_wSL(void);
+extern void b_char(char*,char*,ftnlen), g_char(char*,ftnlen,char*);
+extern int c_sfe(cilist*), z_rnew(void);
+extern int isatty(int);
+extern int err__fl(int,int,char*);
+extern int xrd_SL(void);
+#ifdef __cplusplus
+	}
+#endif
+#endif
+extern int (*f__doend)(Void);
+extern FILE *f__cf;	/*current file*/
+extern unit *f__curunit;	/*current unit*/
+extern unit f__units[];
+#define err(f,m,s) do {if(f) {f__init &= ~2; errno= m;} else f__fatal(m,s); return(m);} while(0)
+#define errfl(f,m,s) do {return err__fl((int)f,m,s);} while(0)
+
+/*Table sizes*/
+#define MXUNIT 100
+
+extern int f__recpos;	/*position in current record*/
+extern int f__cursor;	/* offset to move to */
+extern int f__hiwater;	/* so TL doesn't confuse us */
+
+#define WRITE	1
+#define READ	2
+#define SEQ	3
+#define DIR	4
+#define FMT	5
+#define UNF	6
+#define EXT	7
+#define INT	8
+
+#define buf_end(x) (x->_flag & _IONBF ? x->_ptr : x->_base + BUFSIZ)
diff --git a/gcc/f/runtime/libI77/fmt.c b/gcc/f/runtime/libI77/fmt.c
new file mode 100644
index 00000000000..a82f82153f6
--- /dev/null
+++ b/gcc/f/runtime/libI77/fmt.c
@@ -0,0 +1,516 @@
+#include "f2c.h"
+#include "fio.h"
+#include "fmt.h"
+#define skip(s) while(*s==' ') s++
+#ifdef interdata
+#define SYLMX 300
+#endif
+#ifdef pdp11
+#define SYLMX 300
+#endif
+#ifdef vax
+#define SYLMX 300
+#endif
+#ifndef SYLMX
+#define SYLMX 300
+#endif
+#define GLITCH '\2'
+	/* special quote character for stu */
+extern int f__cursor,f__scale;
+extern flag f__cblank,f__cplus;	/*blanks in I and compulsory plus*/
+struct syl f__syl[SYLMX];
+int f__parenlvl,f__pc,f__revloc;
+
+ static
+#ifdef KR_headers
+char *ap_end(s) char *s;
+#else
+char *ap_end(char *s)
+#endif
+{	char quote;
+	quote= *s++;
+	for(;*s;s++)
+	{	if(*s!=quote) continue;
+		if(*++s!=quote) return(s);
+	}
+	if(f__elist->cierr) {
+		errno = 100;
+		return(NULL);
+	}
+	f__fatal(100, "bad string");
+	/*NOTREACHED*/ return 0;
+}
+ static
+#ifdef KR_headers
+op_gen(a,b,c,d)
+#else
+op_gen(int a, int b, int c, int d)
+#endif
+{	struct syl *p= &f__syl[f__pc];
+	if(f__pc>=SYLMX)
+	{	fprintf(stderr,"format too complicated:\n");
+		sig_die(f__fmtbuf, 1);
+	}
+	p->op=a;
+	p->p1=b;
+	p->p2=c;
+	p->p3=d;
+	return(f__pc++);
+}
+#ifdef KR_headers
+static char *f_list();
+static char *gt_num(s,n,n1) char *s; int *n, n1;
+#else
+static char *f_list(char*);
+static char *gt_num(char *s, int *n, int n1)
+#endif
+{	int m=0,f__cnt=0;
+	char c;
+	for(c= *s;;c = *s)
+	{	if(c==' ')
+		{	s++;
+			continue;
+		}
+		if(c>'9' || c<'0') break;
+		m=10*m+c-'0';
+		f__cnt++;
+		s++;
+	}
+	if(f__cnt==0) {
+		if (!n1)
+			s = 0;
+		*n=n1;
+		}
+	else *n=m;
+	return(s);
+}
+
+ static
+#ifdef KR_headers
+char *f_s(s,curloc) char *s;
+#else
+char *f_s(char *s, int curloc)
+#endif
+{
+	skip(s);
+	if(*s++!='(')
+	{
+		return(NULL);
+	}
+	if(f__parenlvl++ ==1) f__revloc=curloc;
+	if(op_gen(RET1,curloc,0,0)<0 ||
+		(s=f_list(s))==NULL)
+	{
+		return(NULL);
+	}
+	skip(s);
+	return(s);
+}
+
+ static
+#ifdef KR_headers
+ne_d(s,p) char *s,**p;
+#else
+ne_d(char *s, char **p)
+#endif
+{	int n,x,sign=0;
+	struct syl *sp;
+	switch(*s)
+	{
+	default:
+		return(0);
+	case ':': (void) op_gen(COLON,0,0,0); break;
+	case '$':
+		(void) op_gen(NONL, 0, 0, 0); break;
+	case 'B':
+	case 'b':
+		if(*++s=='z' || *s == 'Z') (void) op_gen(BZ,0,0,0);
+		else (void) op_gen(BN,0,0,0);
+		break;
+	case 'S':
+	case 's':
+		if(*(s+1)=='s' || *(s+1) == 'S')
+		{	x=SS;
+			s++;
+		}
+		else if(*(s+1)=='p' || *(s+1) == 'P')
+		{	x=SP;
+			s++;
+		}
+		else x=S;
+		(void) op_gen(x,0,0,0);
+		break;
+	case '/': (void) op_gen(SLASH,0,0,0); break;
+	case '-': sign=1;
+	case '+':	s++;	/*OUTRAGEOUS CODING TRICK*/
+	case '0': case '1': case '2': case '3': case '4':
+	case '5': case '6': case '7': case '8': case '9':
+		if (!(s=gt_num(s,&n,0))) {
+ bad:			*p = 0;
+			return 1;
+			}
+		switch(*s)
+		{
+		default:
+			return(0);
+		case 'P':
+		case 'p': if(sign) n= -n; (void) op_gen(P,n,0,0); break;
+		case 'X':
+		case 'x': (void) op_gen(X,n,0,0); break;
+		case 'H':
+		case 'h':
+			sp = &f__syl[op_gen(H,n,0,0)];
+			*(char **)&sp->p2 = s + 1;
+			s+=n;
+			break;
+		}
+		break;
+	case GLITCH:
+	case '"':
+	case '\'':
+		sp = &f__syl[op_gen(APOS,0,0,0)];
+		*(char **)&sp->p2 = s;
+		if((*p = ap_end(s)) == NULL)
+			return(0);
+		return(1);
+	case 'T':
+	case 't':
+		if(*(s+1)=='l' || *(s+1) == 'L')
+		{	x=TL;
+			s++;
+		}
+		else if(*(s+1)=='r'|| *(s+1) == 'R')
+		{	x=TR;
+			s++;
+		}
+		else x=T;
+		if (!(s=gt_num(s+1,&n,0)))
+			goto bad;
+		s--;
+		(void) op_gen(x,n,0,0);
+		break;
+	case 'X':
+	case 'x': (void) op_gen(X,1,0,0); break;
+	case 'P':
+	case 'p': (void) op_gen(P,1,0,0); break;
+	}
+	s++;
+	*p=s;
+	return(1);
+}
+
+ static
+#ifdef KR_headers
+e_d(s,p) char *s,**p;
+#else
+e_d(char *s, char **p)
+#endif
+{	int i,im,n,w,d,e,found=0,x=0;
+	char *sv=s;
+	s=gt_num(s,&n,1);
+	(void) op_gen(STACK,n,0,0);
+	switch(*s++)
+	{
+	default: break;
+	case 'E':
+	case 'e':	x=1;
+	case 'G':
+	case 'g':
+		found=1;
+		if (!(s=gt_num(s,&w,0))) {
+ bad:
+			*p = 0;
+			return 1;
+			}
+		if(w==0) break;
+		if(*s=='.') {
+			if (!(s=gt_num(s+1,&d,0)))
+				goto bad;
+			}
+		else d=0;
+		if(*s!='E' && *s != 'e')
+			(void) op_gen(x==1?E:G,w,d,0);	/* default is Ew.dE2 */
+		else {
+			if (!(s=gt_num(s+1,&e,0)))
+				goto bad;
+			(void) op_gen(x==1?EE:GE,w,d,e);
+			}
+		break;
+	case 'O':
+	case 'o':
+		i = O;
+		im = OM;
+		goto finish_I;
+	case 'Z':
+	case 'z':
+		i = Z;
+		im = ZM;
+		goto finish_I;
+	case 'L':
+	case 'l':
+		found=1;
+		if (!(s=gt_num(s,&w,0)))
+			goto bad;
+		if(w==0) break;
+		(void) op_gen(L,w,0,0);
+		break;
+	case 'A':
+	case 'a':
+		found=1;
+		skip(s);
+		if(*s>='0' && *s<='9')
+		{	s=gt_num(s,&w,1);
+			if(w==0) break;
+			(void) op_gen(AW,w,0,0);
+			break;
+		}
+		(void) op_gen(A,0,0,0);
+		break;
+	case 'F':
+	case 'f':
+		if (!(s=gt_num(s,&w,0)))
+			goto bad;
+		found=1;
+		if(w==0) break;
+		if(*s=='.') {
+			if (!(s=gt_num(s+1,&d,0)))
+				goto bad;
+			}
+		else d=0;
+		(void) op_gen(F,w,d,0);
+		break;
+	case 'D':
+	case 'd':
+		found=1;
+		if (!(s=gt_num(s,&w,0)))
+			goto bad;
+		if(w==0) break;
+		if(*s=='.') {
+			if (!(s=gt_num(s+1,&d,0)))
+				goto bad;
+			}
+		else d=0;
+		(void) op_gen(D,w,d,0);
+		break;
+	case 'I':
+	case 'i':
+		i = I;
+		im = IM;
+ finish_I:
+		if (!(s=gt_num(s,&w,0)))
+			goto bad;
+		found=1;
+		if(w==0) break;
+		if(*s!='.')
+		{	(void) op_gen(i,w,0,0);
+			break;
+		}
+		if (!(s=gt_num(s+1,&d,0)))
+			goto bad;
+		(void) op_gen(im,w,d,0);
+		break;
+	}
+	if(found==0)
+	{	f__pc--; /*unSTACK*/
+		*p=sv;
+		return(0);
+	}
+	*p=s;
+	return(1);
+}
+ static
+#ifdef KR_headers
+char *i_tem(s) char *s;
+#else
+char *i_tem(char *s)
+#endif
+{	char *t;
+	int n,curloc;
+	if(*s==')') return(s);
+	if(ne_d(s,&t)) return(t);
+	if(e_d(s,&t)) return(t);
+	s=gt_num(s,&n,1);
+	if((curloc=op_gen(STACK,n,0,0))<0) return(NULL);
+	return(f_s(s,curloc));
+}
+
+ static
+#ifdef KR_headers
+char *f_list(s) char *s;
+#else
+char *f_list(char *s)
+#endif
+{
+	for(;*s!=0;)
+	{	skip(s);
+		if((s=i_tem(s))==NULL) return(NULL);
+		skip(s);
+		if(*s==',') s++;
+		else if(*s==')')
+		{	if(--f__parenlvl==0)
+			{
+				(void) op_gen(REVERT,f__revloc,0,0);
+				return(++s);
+			}
+			(void) op_gen(GOTO,0,0,0);
+			return(++s);
+		}
+	}
+	return(NULL);
+}
+
+#ifdef KR_headers
+pars_f(s) char *s;
+#else
+pars_f(char *s)
+#endif
+{
+	f__parenlvl=f__revloc=f__pc=0;
+	if(f_s(s,0) == NULL)
+	{
+		return(-1);
+	}
+	return(0);
+}
+#define STKSZ 10
+int f__cnt[STKSZ],f__ret[STKSZ],f__cp,f__rp;
+flag f__workdone, f__nonl;
+
+ static
+#ifdef KR_headers
+type_f(n)
+#else
+type_f(int n)
+#endif
+{
+	switch(n)
+	{
+	default:
+		return(n);
+	case RET1:
+		return(RET1);
+	case REVERT: return(REVERT);
+	case GOTO: return(GOTO);
+	case STACK: return(STACK);
+	case X:
+	case SLASH:
+	case APOS: case H:
+	case T: case TL: case TR:
+		return(NED);
+	case F:
+	case I:
+	case IM:
+	case A: case AW:
+	case O: case OM:
+	case L:
+	case E: case EE: case D:
+	case G: case GE:
+	case Z: case ZM:
+		return(ED);
+	}
+}
+#ifdef KR_headers
+integer do_fio(number,ptr,len) ftnint *number; ftnlen len; char *ptr;
+#else
+integer do_fio(ftnint *number, char *ptr, ftnlen len)
+#endif
+{	struct syl *p;
+	int n,i;
+	for(i=0;i<*number;i++,ptr+=len)
+	{
+loop:	switch(type_f((p= &f__syl[f__pc])->op))
+	{
+	default:
+		fprintf(stderr,"unknown code in do_fio: %d\n%s\n",
+			p->op,f__fmtbuf);
+		err(f__elist->cierr,100,"do_fio");
+	case NED:
+		if((*f__doned)(p))
+		{	f__pc++;
+			goto loop;
+		}
+		f__pc++;
+		continue;
+	case ED:
+		if(f__cnt[f__cp]<=0)
+		{	f__cp--;
+			f__pc++;
+			goto loop;
+		}
+		if(ptr==NULL)
+			return((*f__doend)());
+		f__cnt[f__cp]--;
+		f__workdone=1;
+		if((n=(*f__doed)(p,ptr,len))>0)
+			errfl(f__elist->cierr,errno,"fmt");
+		if(n<0)
+			err(f__elist->ciend,(EOF),"fmt");
+		continue;
+	case STACK:
+		f__cnt[++f__cp]=p->p1;
+		f__pc++;
+		goto loop;
+	case RET1:
+		f__ret[++f__rp]=p->p1;
+		f__pc++;
+		goto loop;
+	case GOTO:
+		if(--f__cnt[f__cp]<=0)
+		{	f__cp--;
+			f__rp--;
+			f__pc++;
+			goto loop;
+		}
+		f__pc=1+f__ret[f__rp--];
+		goto loop;
+	case REVERT:
+		f__rp=f__cp=0;
+		f__pc = p->p1;
+		if(ptr==NULL)
+			return((*f__doend)());
+		if(!f__workdone) return(0);
+		if((n=(*f__dorevert)()) != 0) return(n);
+		goto loop;
+	case COLON:
+		if(ptr==NULL)
+			return((*f__doend)());
+		f__pc++;
+		goto loop;
+	case NONL:
+		f__nonl = 1;
+		f__pc++;
+		goto loop;
+	case S:
+	case SS:
+		f__cplus=0;
+		f__pc++;
+		goto loop;
+	case SP:
+		f__cplus = 1;
+		f__pc++;
+		goto loop;
+	case P:	f__scale=p->p1;
+		f__pc++;
+		goto loop;
+	case BN:
+		f__cblank=0;
+		f__pc++;
+		goto loop;
+	case BZ:
+		f__cblank=1;
+		f__pc++;
+		goto loop;
+	}
+	}
+	return(0);
+}
+en_fio(Void)
+{	ftnint one=1;
+	return(do_fio(&one,(char *)NULL,(ftnint)0));
+}
+ VOID
+fmt_bg(Void)
+{
+	f__workdone=f__cp=f__rp=f__pc=f__cursor=0;
+	f__cnt[0]=f__ret[0]=0;
+}
diff --git a/gcc/f/runtime/libI77/fmt.h b/gcc/f/runtime/libI77/fmt.h
new file mode 100644
index 00000000000..509746e13b9
--- /dev/null
+++ b/gcc/f/runtime/libI77/fmt.h
@@ -0,0 +1,99 @@
+struct syl
+{	int op,p1,p2,p3;
+};
+#define RET1 1
+#define REVERT 2
+#define GOTO 3
+#define X 4
+#define SLASH 5
+#define STACK 6
+#define I 7
+#define ED 8
+#define NED 9
+#define IM 10
+#define APOS 11
+#define H 12
+#define TL 13
+#define TR 14
+#define T 15
+#define COLON 16
+#define S 17
+#define SP 18
+#define SS 19
+#define P 20
+#define BN 21
+#define BZ 22
+#define F 23
+#define E 24
+#define EE 25
+#define D 26
+#define G 27
+#define GE 28
+#define L 29
+#define A 30
+#define AW 31
+#define O 32
+#define NONL 33
+#define OM 34
+#define Z 35
+#define ZM 36
+extern struct syl f__syl[];
+extern int f__pc,f__parenlvl,f__revloc;
+typedef union
+{	real pf;
+	doublereal pd;
+} ufloat;
+typedef union
+{	short is;
+#ifndef KR_headers
+	signed
+#endif
+		char ic;
+	integer il;
+#ifdef Allow_TYQUAD
+	longint ili;
+#endif
+} Uint;
+#ifdef KR_headers
+extern int (*f__doed)(),(*f__doned)();
+extern int (*f__dorevert)();
+extern int rd_ed(),rd_ned();
+extern int w_ed(),w_ned();
+#else
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern int (*f__doed)(struct syl*, char*, ftnlen),(*f__doned)(struct syl*);
+extern int (*f__dorevert)(void);
+extern void fmt_bg(void);
+extern int pars_f(char*);
+extern int rd_ed(struct syl*, char*, ftnlen),rd_ned(struct syl*);
+extern int w_ed(struct syl*, char*, ftnlen),w_ned(struct syl*);
+extern int wrt_E(ufloat*, int, int, int, ftnlen);
+extern int wrt_F(ufloat*, int, int, ftnlen);
+extern int wrt_L(Uint*, int, ftnlen);
+#ifdef __cplusplus
+	}
+#endif
+#endif
+extern flag f__cblank,f__cplus,f__workdone, f__nonl;
+extern char *f__fmtbuf;
+extern int f__scale;
+#define GET(x) if((x=(*f__getn)())<0) return(x)
+#define VAL(x) (x!='\n'?x:' ')
+#define PUT(x) (*f__putn)(x)
+extern int f__cursor;
+
+#undef TYQUAD
+#ifndef Allow_TYQUAD
+#undef longint
+#define longint long
+#else
+#define TYQUAD 14
+#endif
+
+#ifdef KR_headers
+extern char *f__icvt();
+#else
+extern char *f__icvt(longint, int*, int*, int);
+#endif
diff --git a/gcc/f/runtime/libI77/fmtlib.c b/gcc/f/runtime/libI77/fmtlib.c
new file mode 100644
index 00000000000..91483fc5290
--- /dev/null
+++ b/gcc/f/runtime/libI77/fmtlib.c
@@ -0,0 +1,45 @@
+/*	@(#)fmtlib.c	1.2	*/
+#define MAXINTLENGTH 23
+
+#include "f2c.h"
+#ifndef Allow_TYQUAD
+#undef longint
+#define longint long
+#undef ulongint
+#define ulongint unsigned long
+#endif
+
+#ifdef KR_headers
+char *f__icvt(value,ndigit,sign, base) longint value; int *ndigit,*sign;
+ register int base;
+#else
+char *f__icvt(longint value, int *ndigit, int *sign, int base)
+#endif
+{
+	static char buf[MAXINTLENGTH+1];
+	register int i;
+	ulongint uvalue;
+
+	if(value > 0) {
+		uvalue = value;
+		*sign = 0;
+		}
+	else if (value < 0) {
+		uvalue = -value;
+		*sign = 1;
+		}
+	else {
+		*sign = 0;
+		*ndigit = 1;
+		buf[MAXINTLENGTH-1] = '0';
+		return &buf[MAXINTLENGTH-1];
+		}
+	i = MAXINTLENGTH;
+	do {
+		buf[--i] = (uvalue%base) + '0';
+		uvalue /= base;
+		}
+		while(uvalue > 0);
+	*ndigit = MAXINTLENGTH - i;
+	return &buf[i];
+	}
diff --git a/gcc/f/runtime/libI77/fp.h b/gcc/f/runtime/libI77/fp.h
new file mode 100644
index 00000000000..40743d79f74
--- /dev/null
+++ b/gcc/f/runtime/libI77/fp.h
@@ -0,0 +1,28 @@
+#define FMAX 40
+#define EXPMAXDIGS 8
+#define EXPMAX 99999999
+/* FMAX = max number of nonzero digits passed to atof() */
+/* EXPMAX = 10^EXPMAXDIGS - 1 = largest allowed exponent absolute value */
+
+#ifdef V10 /* Research Tenth-Edition Unix */
+#include "local.h"
+#endif
+
+/* MAXFRACDIGS and MAXINTDIGS are for wrt_F -- bounds (not necessarily
+   tight) on the maximum number of digits to the right and left of
+ * the decimal point.
+ */
+
+#ifdef VAX
+#define MAXFRACDIGS 56
+#define MAXINTDIGS 38
+#else
+#ifdef CRAY
+#define MAXFRACDIGS 9880
+#define MAXINTDIGS 9864
+#else
+/* values that suffice for IEEE double */
+#define MAXFRACDIGS 344
+#define MAXINTDIGS 308
+#endif
+#endif
diff --git a/gcc/f/runtime/libI77/ftell_.c b/gcc/f/runtime/libI77/ftell_.c
new file mode 100644
index 00000000000..1bd03be325a
--- /dev/null
+++ b/gcc/f/runtime/libI77/ftell_.c
@@ -0,0 +1,46 @@
+#include "f2c.h"
+#include "fio.h"
+
+ static FILE *
+#ifdef KR_headers
+unit_chk(Unit, who) integer Unit; char *who;
+#else
+unit_chk(integer Unit, char *who)
+#endif
+{
+	if (Unit >= MXUNIT || Unit < 0)
+		f__fatal(101, who);
+	return f__units[Unit].ufd;
+	}
+
+ integer
+#ifdef KR_headers
+G77_ftell_0 (Unit) integer *Unit;
+#else
+G77_ftell_0 (integer *Unit)
+#endif
+{
+	FILE *f;
+	return (f = unit_chk(*Unit, "ftell")) ? ftell(f) : -1L;
+	}
+
+ integer
+#ifdef KR_headers
+G77_fseek_0 (Unit, offset, xwhence) integer *Unit, *offset, *xwhence;
+#else
+G77_fseek_0 (integer *Unit, integer *offset, integer *xwhence)
+#endif
+{
+	FILE *f;
+	int w = (int)*xwhence;
+#ifdef SEEK_SET
+	static int wohin[3] = { SEEK_SET, SEEK_CUR, SEEK_END };
+#endif
+	if (w < 0 || w > 2)
+		w = 0;
+#ifdef SEEK_SET
+	w = wohin[w];
+#endif
+	return	!(f = unit_chk(*Unit, "fseek"))
+		|| fseek(f, *offset, w) ? 1 : 0;
+	}
diff --git a/gcc/f/runtime/libI77/iio.c b/gcc/f/runtime/libI77/iio.c
new file mode 100644
index 00000000000..680524f6c1a
--- /dev/null
+++ b/gcc/f/runtime/libI77/iio.c
@@ -0,0 +1,147 @@
+#include "f2c.h"
+#include "fio.h"
+#include "fmt.h"
+extern char *f__icptr;
+char *f__icend;
+extern icilist *f__svic;
+int f__icnum;
+extern int f__hiwater;
+z_getc(Void)
+{
+	if(f__recpos++ < f__svic->icirlen) {
+		if(f__icptr >= f__icend) err(f__svic->iciend,(EOF),"endfile");
+		return(*(unsigned char *)f__icptr++);
+		}
+	return '\n';
+}
+#ifdef KR_headers
+z_putc(c)
+#else
+z_putc(int c)
+#endif
+{
+	if(f__icptr >= f__icend) err(f__svic->icierr,110,"inwrite");
+	if(f__recpos++ < f__svic->icirlen)
+		*f__icptr++ = c;
+	else	err(f__svic->icierr,110,"recend");
+	return 0;
+}
+z_rnew(Void)
+{
+	f__icptr = f__svic->iciunit + (++f__icnum)*f__svic->icirlen;
+	f__recpos = 0;
+	f__cursor = 0;
+	f__hiwater = 0;
+	return 1;
+}
+
+ static int
+z_endp(Void)
+{
+	(*f__donewrec)();
+	return 0;
+	}
+
+#ifdef KR_headers
+c_si(a) icilist *a;
+#else
+c_si(icilist *a)
+#endif
+{
+	if (f__init & 2)
+		f__fatal (131, "I/O recursion");
+	f__init |= 2;
+	f__elist = (cilist *)a;
+	f__fmtbuf=a->icifmt;
+	if(pars_f(f__fmtbuf)<0)
+		err(a->icierr,100,"startint");
+	fmt_bg();
+	f__sequential=f__formatted=1;
+	f__external=0;
+	f__cblank=f__cplus=f__scale=0;
+	f__svic=a;
+	f__icnum=f__recpos=0;
+	f__cursor = 0;
+	f__hiwater = 0;
+	f__icptr = a->iciunit;
+	f__icend = f__icptr + a->icirlen*a->icirnum;
+	f__curunit = 0;
+	f__cf = 0;
+	return(0);
+}
+
+ int
+iw_rev(Void)
+{
+	if(f__workdone)
+		z_endp();
+	f__hiwater = f__recpos = f__cursor = 0;
+	return(f__workdone=0);
+	}
+
+#ifdef KR_headers
+integer s_rsfi(a) icilist *a;
+#else
+integer s_rsfi(icilist *a)
+#endif
+{	int n;
+	if(n=c_si(a)) return(n);
+	f__reading=1;
+	f__doed=rd_ed;
+	f__doned=rd_ned;
+	f__getn=z_getc;
+	f__dorevert = z_endp;
+	f__donewrec = z_rnew;
+	f__doend = z_endp;
+	return(0);
+}
+
+z_wnew(Void)
+{
+	if (f__recpos < f__hiwater) {
+		f__icptr += f__hiwater - f__recpos;
+		f__recpos = f__hiwater;
+		}
+	while(f__recpos++ < f__svic->icirlen)
+		*f__icptr++ = ' ';
+	f__recpos = 0;
+	f__cursor = 0;
+	f__hiwater = 0;
+	f__icnum++;
+	return 1;
+}
+#ifdef KR_headers
+integer s_wsfi(a) icilist *a;
+#else
+integer s_wsfi(icilist *a)
+#endif
+{	int n;
+	if(n=c_si(a)) return(n);
+	f__reading=0;
+	f__doed=w_ed;
+	f__doned=w_ned;
+	f__putn=z_putc;
+	f__dorevert = iw_rev;
+	f__donewrec = z_wnew;
+	f__doend = z_endp;
+	return(0);
+}
+integer e_rsfi(Void)
+{	int n;
+	f__init &= ~2;
+	n = en_fio();
+	f__fmtbuf = NULL;
+	return(n);
+}
+integer e_wsfi(Void)
+{
+	int n;
+	f__init &= ~2;
+	n = en_fio();
+	f__fmtbuf = NULL;
+	if(f__icnum >= f__svic->icirnum)
+		return(n);
+	while(f__recpos++ < f__svic->icirlen)
+		*f__icptr++ = ' ';
+	return(n);
+}
diff --git a/gcc/f/runtime/libI77/ilnw.c b/gcc/f/runtime/libI77/ilnw.c
new file mode 100644
index 00000000000..08ea2be7831
--- /dev/null
+++ b/gcc/f/runtime/libI77/ilnw.c
@@ -0,0 +1,82 @@
+#include "f2c.h"
+#include "fio.h"
+#include "lio.h"
+extern char *f__icptr;
+extern char *f__icend;
+extern icilist *f__svic;
+extern int f__icnum;
+#ifdef KR_headers
+extern int z_putc();
+#else
+extern int z_putc(int);
+#endif
+
+ static int
+z_wSL(Void)
+{
+	while(f__recpos < f__svic->icirlen)
+		z_putc(' ');
+	return z_rnew();
+	}
+
+ VOID
+#ifdef KR_headers
+c_liw(a) icilist *a;
+#else
+c_liw(icilist *a)
+#endif
+{
+	f__reading = 0;
+	f__external = 0;
+	f__formatted = 1;
+	f__putn = z_putc;
+	L_len = a->icirlen;
+	f__donewrec = z_wSL;
+	f__svic = a;
+	f__icnum = f__recpos = 0;
+	f__cursor = 0;
+	f__cf = 0;
+	f__curunit = 0;
+	f__icptr = a->iciunit;
+	f__icend = f__icptr + a->icirlen*a->icirnum;
+	f__elist = (cilist *)a;
+	}
+
+ integer
+#ifdef KR_headers
+s_wsni(a) icilist *a;
+#else
+s_wsni(icilist *a)
+#endif
+{
+	cilist ca;
+
+	if(f__init != 1) f_init();
+	f__init = 3;
+	c_liw(a);
+	ca.cifmt = a->icifmt;
+	x_wsne(&ca);
+	z_wSL();
+	return 0;
+	}
+
+ integer
+#ifdef KR_headers
+s_wsli(a) icilist *a;
+#else
+s_wsli(icilist *a)
+#endif
+{
+	if(f__init != 1) f_init();
+	f__init = 3;
+	f__lioproc = l_write;
+	c_liw(a);
+	return(0);
+	}
+
+integer e_wsli(Void)
+{
+	f__init = 1;
+	z_wSL();
+	return(0);
+	}
diff --git a/gcc/f/runtime/libI77/inquire.c b/gcc/f/runtime/libI77/inquire.c
new file mode 100644
index 00000000000..963d4c3e5e8
--- /dev/null
+++ b/gcc/f/runtime/libI77/inquire.c
@@ -0,0 +1,108 @@
+#include "f2c.h"
+#include "fio.h"
+#include <string.h>
+#ifdef KR_headers
+integer f_inqu(a) inlist *a;
+#else
+#if defined (MSDOS) && !defined (GO32)
+#undef abs
+#undef min
+#undef max
+#include "io.h"
+#endif
+integer f_inqu(inlist *a)
+#endif
+{	flag byfile;
+	int i, n;
+	unit *p;
+	char buf[256];
+	long x;
+	if (f__init & 2)
+		f__fatal (131, "I/O recursion");
+	if(a->infile!=NULL)
+	{	byfile=1;
+		g_char(a->infile,a->infilen,buf);
+#ifdef NON_UNIX_STDIO
+		x = access(buf,0) ? -1 : 0;
+		for(i=0,p=NULL;i<MXUNIT;i++)
+			if(f__units[i].ufd != NULL
+			 && f__units[i].ufnm != NULL
+			 && !strcmp(f__units[i].ufnm,buf)) {
+				p = &f__units[i];
+				break;
+				}
+#else
+		x=f__inode(buf, &n);
+		for(i=0,p=NULL;i<MXUNIT;i++)
+			if(f__units[i].uinode==x
+			&& f__units[i].ufd!=NULL
+			&& f__units[i].udev == n) {
+				p = &f__units[i];
+				break;
+				}
+#endif
+	}
+	else
+	{
+		byfile=0;
+		if(a->inunit<MXUNIT && a->inunit>=0)
+		{
+			p= &f__units[a->inunit];
+		}
+		else
+		{
+			p=NULL;
+		}
+	}
+	if(a->inex!=NULL)
+		if(byfile && x != -1 || !byfile && p!=NULL)
+			*a->inex=1;
+		else *a->inex=0;
+	if(a->inopen!=NULL)
+		if(byfile) *a->inopen=(p!=NULL);
+		else *a->inopen=(p!=NULL && p->ufd!=NULL);
+	if(a->innum!=NULL) *a->innum= p-f__units;
+	if(a->innamed!=NULL)
+		if(byfile || p!=NULL && p->ufnm!=NULL)
+			*a->innamed=1;
+		else	*a->innamed=0;
+	if(a->inname!=NULL)
+		if(byfile)
+			b_char(buf,a->inname,a->innamlen);
+		else if(p!=NULL && p->ufnm!=NULL)
+			b_char(p->ufnm,a->inname,a->innamlen);
+	if(a->inacc!=NULL && p!=NULL && p->ufd!=NULL)
+		if(p->url)
+			b_char("DIRECT",a->inacc,a->inacclen);
+		else	b_char("SEQUENTIAL",a->inacc,a->inacclen);
+	if(a->inseq!=NULL)
+		if(p!=NULL && p->url)
+			b_char("NO",a->inseq,a->inseqlen);
+		else	b_char("YES",a->inseq,a->inseqlen);
+	if(a->indir!=NULL)
+		if(p==NULL || p->url)
+			b_char("YES",a->indir,a->indirlen);
+		else	b_char("NO",a->indir,a->indirlen);
+	if(a->infmt!=NULL)
+		if(p!=NULL && p->ufmt==0)
+			b_char("UNFORMATTED",a->infmt,a->infmtlen);
+		else	b_char("FORMATTED",a->infmt,a->infmtlen);
+	if(a->inform!=NULL)
+		if(p!=NULL && p->ufmt==0)
+		b_char("NO",a->inform,a->informlen);
+		else b_char("YES",a->inform,a->informlen);
+	if(a->inunf)
+		if(p!=NULL && p->ufmt==0)
+			b_char("YES",a->inunf,a->inunflen);
+		else if (p!=NULL) b_char("NO",a->inunf,a->inunflen);
+		else b_char("UNKNOWN",a->inunf,a->inunflen);
+	if(a->inrecl!=NULL && p!=NULL)
+		*a->inrecl=p->url;
+	if(a->innrec!=NULL && p!=NULL && p->url>0)
+		*a->innrec=ftell(p->ufd)/p->url+1;
+	if(a->inblank && p!=NULL && p->ufmt)
+		if(p->ublnk)
+			b_char("ZERO",a->inblank,a->inblanklen);
+		else	b_char("NULL",a->inblank,a->inblanklen);
+	return(0);
+}
diff --git a/gcc/f/runtime/libI77/lio.h b/gcc/f/runtime/libI77/lio.h
new file mode 100644
index 00000000000..012317206aa
--- /dev/null
+++ b/gcc/f/runtime/libI77/lio.h
@@ -0,0 +1,74 @@
+/*	copy of ftypes from the compiler */
+/* variable types
+ * numeric assumptions:
+ *	int < reals < complexes
+ *	TYDREAL-TYREAL = TYDCOMPLEX-TYCOMPLEX
+ */
+
+/* 0-10 retain their old (pre LOGICAL*1, etc.) */
+/* values to allow mixing old and new objects. */
+
+#define TYUNKNOWN 0
+#define TYADDR 1
+#define TYSHORT 2
+#define TYLONG 3
+#define TYREAL 4
+#define TYDREAL 5
+#define TYCOMPLEX 6
+#define TYDCOMPLEX 7
+#define TYLOGICAL 8
+#define TYCHAR 9
+#define TYSUBR 10
+#define TYINT1 11
+#define TYLOGICAL1 12
+#define TYLOGICAL2 13
+#ifdef Allow_TYQUAD
+#undef TYQUAD
+#define TYQUAD 14
+#endif
+
+#define	LINTW	24
+#define	LINE	80
+#define	LLOGW	2
+#ifdef Old_list_output
+#define	LLOW	1.0
+#define	LHIGH	1.e9
+#define	LEFMT	" %# .8E"
+#define	LFFMT	" %# .9g"
+#else
+#define	LGFMT	"%.9G"
+#endif
+/* LEFBL 20 should suffice; 24 overcomes a NeXT bug. */
+#define	LEFBL	24
+
+typedef union
+{
+	char	flchar;
+	short	flshort;
+	ftnint	flint;
+#ifdef Allow_TYQUAD
+	longint fllongint;
+#endif
+	real	flreal;
+	doublereal	fldouble;
+} flex;
+extern int f__scale;
+#ifdef KR_headers
+extern int (*f__lioproc)(), (*l_getc)(), (*l_ungetc)();
+extern int l_read(), l_write();
+#else
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern int (*f__lioproc)(ftnint*, char*, ftnlen, ftnint);
+extern int l_write(ftnint*, char*, ftnlen, ftnint);
+extern void x_wsne(cilist*);
+extern int c_le(cilist*), (*l_getc)(void), (*l_ungetc)(int,FILE*);
+extern int l_read(ftnint*,char*,ftnlen,ftnint);
+extern integer e_rsle(void), e_wsle(void), s_wsne(cilist*);
+extern int z_rnew(void);
+#ifdef __cplusplus
+	}
+#endif
+#endif
+extern ftnint L_len;
diff --git a/gcc/f/runtime/libI77/lread.c b/gcc/f/runtime/libI77/lread.c
new file mode 100644
index 00000000000..3f0642c24cd
--- /dev/null
+++ b/gcc/f/runtime/libI77/lread.c
@@ -0,0 +1,684 @@
+#include <ctype.h>
+#include "f2c.h"
+#include "fio.h"
+
+/* Compile with -DF8X_NML_ELIDE_QUOTES to permit eliding quotation */
+/* marks in namelist input a la the Fortran 8X Draft published in  */
+/* the May 1989 issue of Fortran Forum. */
+
+
+extern char *f__fmtbuf;
+
+#ifdef Allow_TYQUAD
+static longint f__llx;
+static int quad_read;
+#endif
+
+#ifdef KR_headers
+extern double atof();
+extern char *malloc(), *realloc();
+int (*f__lioproc)(), (*l_getc)(), (*l_ungetc)();
+#else
+#undef abs
+#undef min
+#undef max
+#include <stdlib.h>
+int (*f__lioproc)(ftnint*, char*, ftnlen, ftnint), (*l_getc)(void),
+	(*l_ungetc)(int,FILE*);
+#endif
+
+#include "fmt.h"
+#include "lio.h"
+#include "fp.h"
+
+int l_eof;
+
+#define isblnk(x) (f__ltab[x+1]&B)
+#define issep(x) (f__ltab[x+1]&SX)
+#define isapos(x) (f__ltab[x+1]&AX)
+#define isexp(x) (f__ltab[x+1]&EX)
+#define issign(x) (f__ltab[x+1]&SG)
+#define iswhit(x) (f__ltab[x+1]&WH)
+#define SX 1
+#define B 2
+#define AX 4
+#define EX 8
+#define SG 16
+#define WH 32
+char f__ltab[128+1] = {	/* offset one for EOF */
+	0,
+	0,0,AX,0,0,0,0,0,0,WH|B,SX|WH,0,0,0,0,0,
+	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+	SX|B|WH,0,AX,0,0,0,0,AX,0,0,0,SG,SX,SG,0,SX,
+	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+	0,0,0,0,EX,EX,0,0,0,0,0,0,0,0,0,0,
+	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+	AX,0,0,0,EX,EX,0,0,0,0,0,0,0,0,0,0,
+	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
+};
+
+#ifdef ungetc
+ static int
+#ifdef KR_headers
+un_getc(x,f__cf) int x; FILE *f__cf;
+#else
+un_getc(int x, FILE *f__cf)
+#endif
+{ return ungetc(x,f__cf); }
+#else
+#define un_getc ungetc
+#ifdef KR_headers
+ extern int ungetc();
+#else
+extern int ungetc(int, FILE*);	/* for systems with a buggy stdio.h */
+#endif
+#endif
+
+t_getc(Void)
+{	int ch;
+	if(f__curunit->uend) return(EOF);
+	if((ch=getc(f__cf))!=EOF) return(ch);
+	if(feof(f__cf))
+		f__curunit->uend = l_eof = 1;
+	return(EOF);
+}
+integer e_rsle(Void)
+{
+	int ch;
+	f__init = 1;
+	if(f__curunit->uend) return(0);
+	while((ch=t_getc())!='\n')
+		if (ch == EOF) {
+			if(feof(f__cf))
+				f__curunit->uend = l_eof = 1;
+			return EOF;
+			}
+	return(0);
+}
+
+flag f__lquit;
+int f__lcount,f__ltype,nml_read;
+char *f__lchar;
+double f__lx,f__ly;
+#define ERR(x) if(n=(x)) {f__init &= ~2; return(n);}
+#define GETC(x) (x=(*l_getc)())
+#define Ungetc(x,y) (*l_ungetc)(x,y)
+
+#ifdef KR_headers
+l_R(poststar) int poststar;
+#else
+l_R(int poststar)
+#endif
+{
+	char s[FMAX+EXPMAXDIGS+4];
+	register int ch;
+	register char *sp, *spe, *sp1;
+	long e, exp;
+	int havenum, havestar, se;
+
+	if (!poststar) {
+		if (f__lcount > 0)
+			return(0);
+		f__lcount = 1;
+		}
+#ifdef Allow_TYQUAD
+	f__llx = 0;
+#endif
+	f__ltype = 0;
+	exp = 0;
+	havestar = 0;
+retry:
+	sp1 = sp = s;
+	spe = sp + FMAX;
+	havenum = 0;
+
+	switch(GETC(ch)) {
+		case '-': *sp++ = ch; sp1++; spe++;
+		case '+':
+			GETC(ch);
+		}
+	while(ch == '0') {
+		++havenum;
+		GETC(ch);
+		}
+	while(isdigit(ch)) {
+		if (sp < spe) *sp++ = ch;
+		else ++exp;
+		GETC(ch);
+		}
+	if (ch == '*' && !poststar) {
+		if (sp == sp1 || exp || *s == '-') {
+			errfl(f__elist->cierr,112,"bad repetition count");
+			}
+		poststar = havestar = 1;
+		*sp = 0;
+		f__lcount = atoi(s);
+		goto retry;
+		}
+	if (ch == '.') {
+		GETC(ch);
+		if (sp == sp1)
+			while(ch == '0') {
+				++havenum;
+				--exp;
+				GETC(ch);
+				}
+		while(isdigit(ch)) {
+			if (sp < spe)
+				{ *sp++ = ch; --exp; }
+			GETC(ch);
+			}
+		}
+	havenum += sp - sp1;
+	se = 0;
+	if (issign(ch))
+		goto signonly;
+	if (havenum && isexp(ch)) {
+		GETC(ch);
+		if (issign(ch)) {
+signonly:
+			if (ch == '-') se = 1;
+			GETC(ch);
+			}
+		if (!isdigit(ch)) {
+bad:
+			errfl(f__elist->cierr,112,"exponent field");
+			}
+
+		e = ch - '0';
+		while(isdigit(GETC(ch))) {
+			e = 10*e + ch - '0';
+			if (e > EXPMAX)
+				goto bad;
+			}
+		if (se)
+			exp -= e;
+		else
+			exp += e;
+		}
+	(void) Ungetc(ch, f__cf);
+	if (sp > sp1) {
+		++havenum;
+		while(*--sp == '0')
+			++exp;
+		if (exp)
+			sprintf(sp+1, "e%ld", exp);
+		else
+			sp[1] = 0;
+		f__lx = atof(s);
+#ifdef Allow_TYQUAD
+		if (quad_read && (se = sp - sp1 + exp) > 14 && se < 20) {
+			/* Assuming 64-bit longint and 32-bit long. */
+			if (exp < 0)
+				sp += exp;
+			if (sp1 <= sp) {
+				f__llx = *sp1 - '0';
+				while(++sp1 <= sp)
+					f__llx = 10*f__llx + (*sp1 - '0');
+				}
+			while(--exp >= 0)
+				f__llx *= 10;
+			if (*s == '-')
+				f__llx = -f__llx;
+			}
+#endif
+		}
+	else
+		f__lx = 0.;
+	if (havenum)
+		f__ltype = TYLONG;
+	else
+		switch(ch) {
+			case ',':
+			case '/':
+				break;
+			default:
+				if (havestar && ( ch == ' '
+						||ch == '\t'
+						||ch == '\n'))
+					break;
+				if (nml_read > 1) {
+					f__lquit = 2;
+					return 0;
+					}
+				errfl(f__elist->cierr,112,"invalid number");
+			}
+	return 0;
+	}
+
+ static int
+#ifdef KR_headers
+rd_count(ch) register int ch;
+#else
+rd_count(register int ch)
+#endif
+{
+	if (ch < '0' || ch > '9')
+		return 1;
+	f__lcount = ch - '0';
+	while(GETC(ch) >= '0' && ch <= '9')
+		f__lcount = 10*f__lcount + ch - '0';
+	Ungetc(ch,f__cf);
+	return f__lcount <= 0;
+	}
+
+l_C(Void)
+{	int ch, nml_save;
+	double lz;
+	if(f__lcount>0) return(0);
+	f__ltype=0;
+	GETC(ch);
+	if(ch!='(')
+	{
+		if (nml_read > 1 && (ch < '0' || ch > '9')) {
+			Ungetc(ch,f__cf);
+			f__lquit = 2;
+			return 0;
+			}
+		if (rd_count(ch))
+			if(!f__cf || !feof(f__cf))
+				errfl(f__elist->cierr,112,"complex format");
+			else
+				err(f__elist->cierr,(EOF),"lread");
+		if(GETC(ch)!='*')
+		{
+			if(!f__cf || !feof(f__cf))
+				errfl(f__elist->cierr,112,"no star");
+			else
+				err(f__elist->cierr,(EOF),"lread");
+		}
+		if(GETC(ch)!='(')
+		{	Ungetc(ch,f__cf);
+			return(0);
+		}
+	}
+	else
+		f__lcount = 1;
+	while(iswhit(GETC(ch)));
+	Ungetc(ch,f__cf);
+	nml_save = nml_read;
+	nml_read = 0;
+	if (ch = l_R(1))
+		return ch;
+	if (!f__ltype)
+		errfl(f__elist->cierr,112,"no real part");
+	lz = f__lx;
+	while(iswhit(GETC(ch)));
+	if(ch!=',')
+	{	(void) Ungetc(ch,f__cf);
+		errfl(f__elist->cierr,112,"no comma");
+	}
+	while(iswhit(GETC(ch)));
+	(void) Ungetc(ch,f__cf);
+	if (ch = l_R(1))
+		return ch;
+	if (!f__ltype)
+		errfl(f__elist->cierr,112,"no imaginary part");
+	while(iswhit(GETC(ch)));
+	if(ch!=')') errfl(f__elist->cierr,112,"no )");
+	f__ly = f__lx;
+	f__lx = lz;
+#ifdef Allow_TYQUAD
+	f__llx = 0;
+#endif
+	nml_read = nml_save;
+	return(0);
+}
+l_L(Void)
+{
+	int ch;
+	if(f__lcount>0) return(0);
+	f__lcount = 1;
+	f__ltype=0;
+	GETC(ch);
+	if(isdigit(ch))
+	{
+		rd_count(ch);
+		if(GETC(ch)!='*')
+			if(!f__cf || !feof(f__cf))
+				errfl(f__elist->cierr,112,"no star");
+			else
+				err(f__elist->cierr,(EOF),"lread");
+		GETC(ch);
+	}
+	if(ch == '.') GETC(ch);
+	switch(ch)
+	{
+	case 't':
+	case 'T':
+		f__lx=1;
+		break;
+	case 'f':
+	case 'F':
+		f__lx=0;
+		break;
+	default:
+		if(isblnk(ch) || issep(ch) || ch==EOF)
+		{	(void) Ungetc(ch,f__cf);
+			return(0);
+		}
+		if (nml_read > 1) {
+			Ungetc(ch,f__cf);
+			f__lquit = 2;
+			return 0;
+			}
+		errfl(f__elist->cierr,112,"logical");
+	}
+	f__ltype=TYLONG;
+	while(!issep(GETC(ch)) && ch!=EOF);
+	(void) Ungetc(ch, f__cf);
+	return(0);
+}
+#define BUFSIZE	128
+l_CHAR(Void)
+{	int ch,size,i;
+	static char rafail[] = "realloc failure";
+	char quote,*p;
+	if(f__lcount>0) return(0);
+	f__ltype=0;
+	if(f__lchar!=NULL) free(f__lchar);
+	size=BUFSIZE;
+	p=f__lchar = (char *)malloc((unsigned int)size);
+	if(f__lchar == NULL)
+		errfl(f__elist->cierr,113,"no space");
+
+	GETC(ch);
+	if(isdigit(ch)) {
+		/* allow Fortran 8x-style unquoted string...	*/
+		/* either find a repetition count or the string	*/
+		f__lcount = ch - '0';
+		*p++ = ch;
+		for(i = 1;;) {
+			switch(GETC(ch)) {
+				case '*':
+					if (f__lcount == 0) {
+						f__lcount = 1;
+#ifndef F8X_NML_ELIDE_QUOTES
+						if (nml_read)
+							goto no_quote;
+#endif
+						goto noquote;
+						}
+					p = f__lchar;
+					goto have_lcount;
+				case ',':
+				case ' ':
+				case '\t':
+				case '\n':
+				case '/':
+					Ungetc(ch,f__cf);
+					/* no break */
+				case EOF:
+					f__lcount = 1;
+					f__ltype = TYCHAR;
+					return *p = 0;
+				}
+			if (!isdigit(ch)) {
+				f__lcount = 1;
+#ifndef F8X_NML_ELIDE_QUOTES
+				if (nml_read) {
+ no_quote:
+					errfl(f__elist->cierr,112,
+						"undelimited character string");
+					}
+#endif
+				goto noquote;
+				}
+			*p++ = ch;
+			f__lcount = 10*f__lcount + ch - '0';
+			if (++i == size) {
+				f__lchar = (char *)realloc(f__lchar,
+					(unsigned int)(size += BUFSIZE));
+				if(f__lchar == NULL)
+					errfl(f__elist->cierr,113,rafail);
+				p = f__lchar + i;
+				}
+			}
+		}
+	else	(void) Ungetc(ch,f__cf);
+ have_lcount:
+	if(GETC(ch)=='\'' || ch=='"') quote=ch;
+	else if(isblnk(ch) || (issep(ch) && ch != '\n') || ch==EOF) {
+		Ungetc(ch,f__cf);
+		return 0;
+		}
+#ifndef F8X_NML_ELIDE_QUOTES
+	else if (nml_read > 1) {
+		Ungetc(ch,f__cf);
+		f__lquit = 2;
+		return 0;
+		}
+#endif
+	else {
+		/* Fortran 8x-style unquoted string */
+		*p++ = ch;
+		for(i = 1;;) {
+			switch(GETC(ch)) {
+				case ',':
+				case ' ':
+				case '\t':
+				case '\n':
+				case '/':
+					Ungetc(ch,f__cf);
+					/* no break */
+				case EOF:
+					f__ltype = TYCHAR;
+					return *p = 0;
+				}
+ noquote:
+			*p++ = ch;
+			if (++i == size) {
+				f__lchar = (char *)realloc(f__lchar,
+					(unsigned int)(size += BUFSIZE));
+				if(f__lchar == NULL)
+					errfl(f__elist->cierr,113,rafail);
+				p = f__lchar + i;
+				}
+			}
+		}
+	f__ltype=TYCHAR;
+	for(i=0;;)
+	{	while(GETC(ch)!=quote && ch!='\n'
+			&& ch!=EOF && ++i<size) *p++ = ch;
+		if(i==size)
+		{
+		newone:
+			f__lchar= (char *)realloc(f__lchar,
+					(unsigned int)(size += BUFSIZE));
+			if(f__lchar == NULL)
+				errfl(f__elist->cierr,113,rafail);
+			p=f__lchar+i-1;
+			*p++ = ch;
+		}
+		else if(ch==EOF) return(EOF);
+		else if(ch=='\n')
+		{	if(*(p-1) != '\\') continue;
+			i--;
+			p--;
+			if(++i<size) *p++ = ch;
+			else goto newone;
+		}
+		else if(GETC(ch)==quote)
+		{	if(++i<size) *p++ = ch;
+			else goto newone;
+		}
+		else
+		{	(void) Ungetc(ch,f__cf);
+			*p = 0;
+			return(0);
+		}
+	}
+}
+#ifdef KR_headers
+c_le(a) cilist *a;
+#else
+c_le(cilist *a)
+#endif
+{
+	if(f__init != 1) f_init();
+	f__init = 3;
+	f__fmtbuf="list io";
+	if(a->ciunit>=MXUNIT || a->ciunit<0)
+		err(a->cierr,101,"stler");
+	f__scale=f__recpos=0;
+	f__elist=a;
+	f__curunit = &f__units[a->ciunit];
+	if(f__curunit->ufd==NULL && fk_open(SEQ,FMT,a->ciunit))
+		err(a->cierr,102,"lio");
+	f__cf=f__curunit->ufd;
+	if(!f__curunit->ufmt) err(a->cierr,103,"lio");
+	return(0);
+}
+#ifdef KR_headers
+l_read(number,ptr,len,type) ftnint *number,type; char *ptr; ftnlen len;
+#else
+l_read(ftnint *number, char *ptr, ftnlen len, ftnint type)
+#endif
+{
+#define Ptr ((flex *)ptr)
+	int i,n,ch;
+	doublereal *yy;
+	real *xx;
+	for(i=0;i<*number;i++)
+	{
+		if(f__lquit) return(0);
+		if(l_eof)
+			err(f__elist->ciend, EOF, "list in");
+		if(f__lcount == 0) {
+			f__ltype = 0;
+			for(;;)  {
+				GETC(ch);
+				switch(ch) {
+				case EOF:
+					err(f__elist->ciend,(EOF),"list in");
+				case ' ':
+				case '\t':
+				case '\n':
+					continue;
+				case '/':
+					f__lquit = 1;
+					goto loopend;
+				case ',':
+					f__lcount = 1;
+					goto loopend;
+				default:
+					(void) Ungetc(ch, f__cf);
+					goto rddata;
+				}
+			}
+		}
+	rddata:
+		switch((int)type)
+		{
+		case TYINT1:
+		case TYSHORT:
+		case TYLONG:
+		case TYREAL:
+		case TYDREAL:
+			ERR(l_R(0));
+			break;
+#ifdef TYQUAD
+		case TYQUAD:
+			quad_read = 1;
+			n = l_R(0);
+			quad_read = 0;
+			ERR(n);
+			break;
+#endif
+		case TYCOMPLEX:
+		case TYDCOMPLEX:
+			ERR(l_C());
+			break;
+		case TYLOGICAL1:
+		case TYLOGICAL2:
+		case TYLOGICAL:
+			ERR(l_L());
+			break;
+		case TYCHAR:
+			ERR(l_CHAR());
+			break;
+		}
+	while (GETC(ch) == ' ' || ch == '\t');
+	if (ch != ',' || f__lcount > 1)
+		Ungetc(ch,f__cf);
+	loopend:
+		if(f__lquit) return(0);
+		if(f__cf && ferror(f__cf)) {
+			clearerr(f__cf);
+			errfl(f__elist->cierr,errno,"list in");
+			}
+		if(f__ltype==0) goto bump;
+		switch((int)type)
+		{
+		case TYINT1:
+		case TYLOGICAL1:
+			Ptr->flchar = (char)f__lx;
+			break;
+		case TYLOGICAL2:
+		case TYSHORT:
+			Ptr->flshort = (short)f__lx;
+			break;
+		case TYLOGICAL:
+		case TYLONG:
+			Ptr->flint=f__lx;
+			break;
+#ifdef Allow_TYQUAD
+		case TYQUAD:
+			if (!(Ptr->fllongint = f__llx))
+				Ptr->fllongint = f__lx;
+			break;
+#endif
+		case TYREAL:
+			Ptr->flreal=f__lx;
+			break;
+		case TYDREAL:
+			Ptr->fldouble=f__lx;
+			break;
+		case TYCOMPLEX:
+			xx=(real *)ptr;
+			*xx++ = f__lx;
+			*xx = f__ly;
+			break;
+		case TYDCOMPLEX:
+			yy=(doublereal *)ptr;
+			*yy++ = f__lx;
+			*yy = f__ly;
+			break;
+		case TYCHAR:
+			b_char(f__lchar,ptr,len);
+			break;
+		}
+	bump:
+		if(f__lcount>0) f__lcount--;
+		ptr += len;
+		if (nml_read)
+			nml_read++;
+	}
+	return(0);
+#undef Ptr
+}
+#ifdef KR_headers
+integer s_rsle(a) cilist *a;
+#else
+integer s_rsle(cilist *a)
+#endif
+{
+	int n;
+
+	if(n=c_le(a)) return(n);
+	f__reading=1;
+	f__external=1;
+	f__formatted=1;
+	f__lioproc = l_read;
+	f__lquit = 0;
+	f__lcount = 0;
+	l_eof = 0;
+	if(f__curunit->uwrt && f__nowreading(f__curunit))
+		err(a->cierr,errno,"read start");
+	if(f__curunit->uend)
+		err(f__elist->ciend,(EOF),"read start");
+	l_getc = t_getc;
+	l_ungetc = un_getc;
+	f__doend = xrd_SL;
+	return(0);
+}
diff --git a/gcc/f/runtime/libI77/lwrite.c b/gcc/f/runtime/libI77/lwrite.c
new file mode 100644
index 00000000000..5da7dfbb972
--- /dev/null
+++ b/gcc/f/runtime/libI77/lwrite.c
@@ -0,0 +1,310 @@
+#include "f2c.h"
+#include "fio.h"
+#include "fmt.h"
+#include "lio.h"
+
+ftnint L_len;
+int f__Aquote;
+
+ static VOID
+donewrec(Void)
+{
+	if (f__recpos)
+		(*f__donewrec)();
+	}
+
+#ifdef KR_headers
+t_putc(c)
+#else
+t_putc(int c)
+#endif
+{
+	f__recpos++;
+	putc(c,f__cf);
+	return(0);
+}
+ static VOID
+#ifdef KR_headers
+lwrt_I(n) longint n;
+#else
+lwrt_I(longint n)
+#endif
+{
+	char *p;
+	int ndigit, sign;
+
+	p = f__icvt(n, &ndigit, &sign, 10);
+	if(f__recpos + ndigit >= L_len)
+		donewrec();
+	PUT(' ');
+	if (sign)
+		PUT('-');
+	while(*p)
+		PUT(*p++);
+}
+ static VOID
+#ifdef KR_headers
+lwrt_L(n, len) ftnint n; ftnlen len;
+#else
+lwrt_L(ftnint n, ftnlen len)
+#endif
+{
+	if(f__recpos+LLOGW>=L_len)
+		donewrec();
+	wrt_L((Uint *)&n,LLOGW, len);
+}
+ static VOID
+#ifdef KR_headers
+lwrt_A(p,len) char *p; ftnlen len;
+#else
+lwrt_A(char *p, ftnlen len)
+#endif
+{
+	int a;
+	char *p1, *pe;
+
+	a = 0;
+	pe = p + len;
+	if (f__Aquote) {
+		a = 3;
+		if (len > 1 && p[len-1] == ' ') {
+			while(--len > 1 && p[len-1] == ' ');
+			pe = p + len;
+			}
+		p1 = p;
+		while(p1 < pe)
+			if (*p1++ == '\'')
+				a++;
+		}
+	if(f__recpos+len+a >= L_len)
+		donewrec();
+	if (a
+#ifndef OMIT_BLANK_CC
+		|| !f__recpos
+#endif
+		)
+		PUT(' ');
+	if (a) {
+		PUT('\'');
+		while(p < pe) {
+			if (*p == '\'')
+				PUT('\'');
+			PUT(*p++);
+			}
+		PUT('\'');
+		}
+	else
+		while(p < pe)
+			PUT(*p++);
+}
+
+ static int
+#ifdef KR_headers
+l_g(buf, n) char *buf; double n;
+#else
+l_g(char *buf, double n)
+#endif
+{
+#ifdef Old_list_output
+	doublereal absn;
+	char *fmt;
+
+	absn = n;
+	if (absn < 0)
+		absn = -absn;
+	fmt = LLOW <= absn && absn < LHIGH ? LFFMT : LEFMT;
+#ifdef USE_STRLEN
+	sprintf(buf, fmt, n);
+	return strlen(buf);
+#else
+	return sprintf(buf, fmt, n);
+#endif
+
+#else
+	register char *b, c, c1;
+
+	b = buf;
+	*b++ = ' ';
+	if (n < 0) {
+		*b++ = '-';
+		n = -n;
+		}
+	else
+		*b++ = ' ';
+	if (n == 0) {
+		*b++ = '0';
+		*b++ = '.';
+		*b = 0;
+		goto f__ret;
+		}
+	sprintf(b, LGFMT, n);
+	switch(*b) {
+#ifndef WANT_LEAD_0
+		case '0':
+			while(b[0] = b[1])
+				b++;
+			break;
+#endif
+		case 'i':
+		case 'I':
+			/* Infinity */
+		case 'n':
+		case 'N':
+			/* NaN */
+			while(*++b);
+			break;
+
+		default:
+	/* Fortran 77 insists on having a decimal point... */
+		    for(;; b++)
+			switch(*b) {
+			case 0:
+				*b++ = '.';
+				*b = 0;
+				goto f__ret;
+			case '.':
+				while(*++b);
+				goto f__ret;
+			case 'E':
+				for(c1 = '.', c = 'E';  *b = c1;
+					c1 = c, c = *++b);
+				goto f__ret;
+			}
+		}
+ f__ret:
+	return b - buf;
+#endif
+	}
+
+ static VOID
+#ifdef KR_headers
+l_put(s) register char *s;
+#else
+l_put(register char *s)
+#endif
+{
+#ifdef KR_headers
+	register int c, (*pn)() = f__putn;
+#else
+	register int c, (*pn)(int) = f__putn;
+#endif
+	while(c = *s++)
+		(*pn)(c);
+	}
+
+ static VOID
+#ifdef KR_headers
+lwrt_F(n) double n;
+#else
+lwrt_F(double n)
+#endif
+{
+	char buf[LEFBL];
+
+	if(f__recpos + l_g(buf,n) >= L_len)
+		donewrec();
+	l_put(buf);
+}
+ static VOID
+#ifdef KR_headers
+lwrt_C(a,b) double a,b;
+#else
+lwrt_C(double a, double b)
+#endif
+{
+	char *ba, *bb, bufa[LEFBL], bufb[LEFBL];
+	int al, bl;
+
+	al = l_g(bufa, a);
+	for(ba = bufa; *ba == ' '; ba++)
+		--al;
+	bl = l_g(bufb, b) + 1;	/* intentionally high by 1 */
+	for(bb = bufb; *bb == ' '; bb++)
+		--bl;
+	if(f__recpos + al + bl + 3 >= L_len)
+		donewrec();
+#ifdef OMIT_BLANK_CC
+	else
+#endif
+	PUT(' ');
+	PUT('(');
+	l_put(ba);
+	PUT(',');
+	if (f__recpos + bl >= L_len) {
+		(*f__donewrec)();
+#ifndef OMIT_BLANK_CC
+		PUT(' ');
+#endif
+		}
+	l_put(bb);
+	PUT(')');
+}
+#ifdef KR_headers
+l_write(number,ptr,len,type) ftnint *number,type; char *ptr; ftnlen len;
+#else
+l_write(ftnint *number, char *ptr, ftnlen len, ftnint type)
+#endif
+{
+#define Ptr ((flex *)ptr)
+	int i;
+	longint x;
+	double y,z;
+	real *xx;
+	doublereal *yy;
+	for(i=0;i< *number; i++)
+	{
+		switch((int)type)
+		{
+		default: f__fatal(204,"unknown type in lio");
+		case TYINT1:
+			x = Ptr->flchar;
+			goto xint;
+		case TYSHORT:
+			x=Ptr->flshort;
+			goto xint;
+#ifdef Allow_TYQUAD
+		case TYQUAD:
+			x = Ptr->fllongint;
+			goto xint;
+#endif
+		case TYLONG:
+			x=Ptr->flint;
+		xint:	lwrt_I(x);
+			break;
+		case TYREAL:
+			y=Ptr->flreal;
+			goto xfloat;
+		case TYDREAL:
+			y=Ptr->fldouble;
+		xfloat: lwrt_F(y);
+			break;
+		case TYCOMPLEX:
+			xx= &Ptr->flreal;
+			y = *xx++;
+			z = *xx;
+			goto xcomplex;
+		case TYDCOMPLEX:
+			yy = &Ptr->fldouble;
+			y= *yy++;
+			z = *yy;
+		xcomplex:
+			lwrt_C(y,z);
+			break;
+		case TYLOGICAL1:
+			x = Ptr->flchar;
+			goto xlog;
+		case TYLOGICAL2:
+			x = Ptr->flshort;
+			goto xlog;
+		case TYLOGICAL:
+			x = Ptr->flint;
+		xlog:	lwrt_L(Ptr->flint, len);
+			break;
+		case TYCHAR:
+			lwrt_A(ptr,len);
+			break;
+		}
+		ptr += len;
+	}
+	return(0);
+}
diff --git a/gcc/f/runtime/libI77/makefile.netlib b/gcc/f/runtime/libI77/makefile.netlib
new file mode 100644
index 00000000000..edba1fe8569
--- /dev/null
+++ b/gcc/f/runtime/libI77/makefile.netlib
@@ -0,0 +1,104 @@
+.SUFFIXES: .c .o
+CC = cc
+CFLAGS = -O
+SHELL = /bin/sh
+
+# compile, then strip unnecessary symbols
+.c.o:
+	$(CC) -c -DSkip_f2c_Undefs $(CFLAGS) $*.c
+	ld -r -x -o $*.xxx $*.o
+	mv $*.xxx $*.o
+## Under Solaris (and other systems that do not understand ld -x),
+## omit -x in the ld line above.
+## If your system does not have the ld command, comment out
+## or remove both the ld and mv lines above.
+
+OBJ =	Version.o backspace.o close.o dfe.o dolio.o due.o endfile.o err.o \
+	fmt.o fmtlib.o ftell_.o iio.o ilnw.o inquire.o lread.o lwrite.o \
+	open.o rdfmt.o rewind.o rsfe.o rsli.o rsne.o sfe.o sue.o typesize.o \
+	uio.o util.o wref.o wrtfmt.o wsfe.o wsle.o wsne.o xwsne.o
+libI77.a:	$(OBJ)
+		ar r libI77.a $?
+		-ranlib libI77.a
+
+### If your system lacks ranlib, you don't need it; see README.
+
+install:	libI77.a
+	cp libI77.a /usr/lib/libI77.a
+	ranlib /usr/lib/libI77.a
+
+Version.o: Version.c
+	$(CC) -c Version.c
+
+# To compile with C++, first "make f2c.h"
+f2c.h: f2ch.add
+	cat /usr/include/f2c.h f2ch.add >f2c.h
+
+
+clean:
+	rm -f $(OBJ) libI77.a
+
+clobber:	clean
+	rm -f libI77.a
+
+backspace.o:	fio.h
+close.o:	fio.h
+dfe.o:		fio.h
+dfe.o:		fmt.h
+due.o:		fio.h
+endfile.o:	fio.h rawio.h
+err.o:		fio.h rawio.h
+fmt.o:		fio.h
+fmt.o:		fmt.h
+ftell_.o:	fio.h
+iio.o:		fio.h
+iio.o:		fmt.h
+ilnw.o:		fio.h
+ilnw.o:		lio.h
+inquire.o:	fio.h
+lread.o:	fio.h
+lread.o:	fmt.h
+lread.o:	lio.h
+lread.o:	fp.h
+lwrite.o:	fio.h
+lwrite.o:	fmt.h
+lwrite.o:	lio.h
+open.o:		fio.h rawio.h
+rdfmt.o:	fio.h
+rdfmt.o:	fmt.h
+rdfmt.o:	fp.h
+rewind.o:	fio.h
+rsfe.o:		fio.h
+rsfe.o:		fmt.h
+rsli.o:		fio.h
+rsli.o:		lio.h
+rsne.o:		fio.h
+rsne.o:		lio.h
+sfe.o:		fio.h
+sue.o:		fio.h
+uio.o:		fio.h
+util.o:		fio.h
+wref.o:		fio.h
+wref.o:		fmt.h
+wref.o:		fp.h
+wrtfmt.o:	fio.h
+wrtfmt.o:	fmt.h
+wsfe.o:		fio.h
+wsfe.o:		fmt.h
+wsle.o:		fio.h
+wsle.o:		fmt.h
+wsle.o:		lio.h
+wsne.o:		fio.h
+wsne.o:		lio.h
+xwsne.o:	fio.h
+xwsne.o:	lio.h
+xwsne.o:	fmt.h
+
+check:
+	xsum Notice README Version.c backspace.c close.c dfe.c dolio.c \
+	due.c endfile.c err.c f2ch.add fio.h fmt.c fmt.h fmtlib.c fp.h \
+	ftell_.c iio.c ilnw.c inquire.c lio.h lread.c lwrite.c makefile \
+	open.c rawio.h rdfmt.c rewind.c rsfe.c rsli.c rsne.c sfe.c sue.c \
+	typesize.c uio.c util.c wref.c wrtfmt.c wsfe.c wsle.c wsne.c \
+	xwsne.c >zap
+	cmp zap libI77.xsum && rm zap || diff libI77.xsum zap
diff --git a/gcc/f/runtime/libI77/open.c b/gcc/f/runtime/libI77/open.c
new file mode 100644
index 00000000000..b08302b5b2c
--- /dev/null
+++ b/gcc/f/runtime/libI77/open.c
@@ -0,0 +1,245 @@
+#ifndef NON_UNIX_STDIO
+#include <sys/types.h>
+#include <sys/stat.h>
+#endif
+#include "f2c.h"
+#include "fio.h"
+#include <string.h>
+#include "rawio.h"
+
+#ifdef KR_headers
+extern char *malloc(), *mktemp();
+extern integer f_clos();
+#else
+#undef abs
+#undef min
+#undef max
+#include <stdlib.h>
+extern int f__canseek(FILE*);
+extern integer f_clos(cllist*);
+#endif
+
+#ifdef NON_ANSI_RW_MODES
+char *f__r_mode[2] = {"r", "r"};
+char *f__w_mode[4] = {"w", "w", "r+w", "r+w"};
+#else
+char *f__r_mode[2] = {"rb", "r"};
+char *f__w_mode[4] = {"wb", "w", "r+b", "r+"};
+#endif
+
+#ifdef KR_headers
+f__isdev(s) char *s;
+#else
+f__isdev(char *s)
+#endif
+{
+#ifdef NON_UNIX_STDIO
+	int i, j;
+
+	i = open(s,O_RDONLY);
+	if (i == -1)
+		return 0;
+	j = isatty(i);
+	close(i);
+	return j;
+#else
+	struct stat x;
+
+	if(stat(s, &x) == -1) return(0);
+#ifdef S_IFMT
+	switch(x.st_mode&S_IFMT) {
+		case S_IFREG:
+		case S_IFDIR:
+			return(0);
+		}
+#else
+#ifdef S_ISREG
+	/* POSIX version */
+	if(S_ISREG(x.st_mode) || S_ISDIR(x.st_mode))
+		return(0);
+	else
+#else
+	Help! How does stat work on this system?
+#endif
+#endif
+		return(1);
+#endif
+}
+#ifdef KR_headers
+integer f_open(a) olist *a;
+#else
+integer f_open(olist *a)
+#endif
+{	unit *b;
+	integer rv;
+	char buf[256], *s;
+	cllist x;
+	int ufmt;
+#ifdef NON_UNIX_STDIO
+	FILE *tf;
+#else
+	int n;
+	struct stat stb;
+#endif
+	if(f__init != 1) f_init();
+	if(a->ounit>=MXUNIT || a->ounit<0)
+		err(a->oerr,101,"open");
+	f__curunit = b = &f__units[a->ounit];
+	if(b->ufd) {
+		if(a->ofnm==0)
+		{
+		same:	if (a->oblnk)
+				b->ublnk = *a->oblnk == 'z' || *a->oblnk == 'Z';
+			return(0);
+		}
+#ifdef NON_UNIX_STDIO
+		if (b->ufnm
+		 && strlen(b->ufnm) == a->ofnmlen
+		 && !strncmp(b->ufnm, b->ufnm, (unsigned)a->ofnmlen))
+			goto same;
+#else
+		g_char(a->ofnm,a->ofnmlen,buf);
+		if (f__inode(buf,&n) == b->uinode && n == b->udev)
+			goto same;
+#endif
+		x.cunit=a->ounit;
+		x.csta=0;
+		x.cerr=a->oerr;
+		if ((rv = f_clos(&x)) != 0)
+			return rv;
+		}
+	b->url = (int)a->orl;
+	b->ublnk = a->oblnk && (*a->oblnk == 'z' || *a->oblnk == 'Z');
+	if(a->ofm==0)
+	{	if(b->url>0) b->ufmt=0;
+		else b->ufmt=1;
+	}
+	else if(*a->ofm=='f' || *a->ofm == 'F') b->ufmt=1;
+	else b->ufmt=0;
+	ufmt = b->ufmt;
+#ifdef url_Adjust
+	if (b->url && !ufmt)
+		url_Adjust(b->url);
+#endif
+	if (a->ofnm) {
+		g_char(a->ofnm,a->ofnmlen,buf);
+		if (!buf[0])
+			err(a->oerr,107,"open");
+		}
+	else
+		sprintf(buf, "fort.%ld", a->ounit);
+	b->uscrtch = 0;
+	switch(a->osta ? *a->osta : 'u')
+	{
+	case 'o':
+	case 'O':
+#ifdef NON_UNIX_STDIO
+		if(access(buf,0))
+#else
+		if(stat(buf,&stb))
+#endif
+			err(a->oerr,errno,"open");
+		break;
+	 case 's':
+	 case 'S':
+		b->uscrtch=1;
+#ifdef _POSIX_SOURCE
+		tmpnam(buf);
+#else
+		(void) strcpy(buf,"tmp.FXXXXXX");
+		(void) mktemp(buf);
+#endif
+		goto replace;
+	case 'n':
+	case 'N':
+#ifdef NON_UNIX_STDIO
+		if(!access(buf,0))
+#else
+		if(!stat(buf,&stb))
+#endif
+			err(a->oerr,128,"open");
+		/* no break */
+	case 'r':	/* Fortran 90 replace option */
+	case 'R':
+ replace:
+#ifdef NON_UNIX_STDIO
+		if (tf = fopen(buf,f__w_mode[0]))
+			fclose(tf);
+#else
+		(void) close(creat(buf, 0666));
+#endif
+	}
+
+	b->ufnm=(char *) malloc((unsigned int)(strlen(buf)+1));
+	if(b->ufnm==NULL) err(a->oerr,113,"no space");
+	(void) strcpy(b->ufnm,buf);
+	b->uend=0;
+	b->uwrt = 0;
+#ifdef NON_UNIX_STDIO
+	if ((s = a->oacc) && (*s == 'd' || *s == 'D'))
+		ufmt = 0;
+#endif
+	if(f__isdev(buf))
+	{	b->ufd = fopen(buf,f__r_mode[ufmt]);
+		if(b->ufd==NULL) err(a->oerr,errno,buf);
+	}
+	else {
+		if(!(b->ufd = fopen(buf, f__r_mode[ufmt]))) {
+#ifdef NON_UNIX_STDIO
+			if (b->ufd = fopen(buf, f__w_mode[ufmt|2]))
+				b->uwrt = 2;
+			else if (b->ufd = fopen(buf, f__w_mode[ufmt]))
+				b->uwrt = 1;
+			else
+#else
+			if ((n = open(buf,O_WRONLY)) >= 0)
+				b->uwrt = 2;
+			else {
+				n = creat(buf, 0666);
+				b->uwrt = 1;
+				}
+			if (n < 0
+			|| (b->ufd = fdopen(n, f__w_mode[ufmt])) == NULL)
+#endif
+				err(a->oerr, errno, "open");
+			}
+	}
+	b->useek=f__canseek(b->ufd);
+#ifndef NON_UNIX_STDIO
+	if((b->uinode=f__inode(buf,&b->udev))==-1)
+		err(a->oerr,108,"open");
+#endif
+	if(b->useek)
+		if (a->orl)
+			rewind(b->ufd);
+		else if ((s = a->oacc) && (*s == 'a' || *s == 'A')
+			&& fseek(b->ufd, 0L, SEEK_END))
+				err(a->oerr,129,"open");
+	return(0);
+}
+#ifdef KR_headers
+fk_open(seq,fmt,n) ftnint n;
+#else
+fk_open(int seq, int fmt, ftnint n)
+#endif
+{	char nbuf[10];
+	olist a;
+	int rtn;
+	int save_init;
+
+	(void) sprintf(nbuf,"fort.%ld",n);
+	a.oerr=1;
+	a.ounit=n;
+	a.ofnm=nbuf;
+	a.ofnmlen=strlen(nbuf);
+	a.osta=NULL;
+	a.oacc= seq==SEQ?"s":"d";
+	a.ofm = fmt==FMT?"f":"u";
+	a.orl = seq==DIR?1:0;
+	a.oblnk=NULL;
+	save_init = f__init;
+	f__init &= ~2;
+	rtn = f_open(&a);
+	f__init = save_init | 1;
+	return rtn;
+}
diff --git a/gcc/f/runtime/libI77/rawio.h b/gcc/f/runtime/libI77/rawio.h
new file mode 100644
index 00000000000..cc5cab8b7bb
--- /dev/null
+++ b/gcc/f/runtime/libI77/rawio.h
@@ -0,0 +1,45 @@
+#ifdef KR_headers
+extern FILE *fdopen();
+#else
+#if defined (MSDOS) && !defined (GO32)
+#include "io.h"
+#ifndef WATCOM
+#define close _close
+#define creat _creat
+#define open _open
+#define read _read
+#define write _write
+#endif /*WATCOM*/
+#endif /*MSDOS*/
+#ifdef __cplusplus
+extern "C" {
+#endif
+#if !(defined (MSDOS) && !defined (GO32))
+#ifdef OPEN_DECL
+extern int creat(const char*,int), open(const char*,int);
+#endif
+extern int close(int);
+extern int read(int,void*,size_t), write(int,void*,size_t);
+extern int unlink(const char*);
+#ifndef _POSIX_SOURCE
+#ifndef NON_UNIX_STDIO
+extern FILE *fdopen(int, const char*);
+#endif
+#endif
+#endif /*KR_HEADERS*/
+
+extern char *mktemp(char*);
+
+#ifdef __cplusplus
+	}
+#endif
+#endif
+
+#ifndef NO_FCNTL
+#include <fcntl.h>
+#endif
+
+#ifndef O_WRONLY
+#define O_RDONLY 0
+#define O_WRONLY 1
+#endif
diff --git a/gcc/f/runtime/libI77/rdfmt.c b/gcc/f/runtime/libI77/rdfmt.c
new file mode 100644
index 00000000000..0d8c2b4d9ca
--- /dev/null
+++ b/gcc/f/runtime/libI77/rdfmt.c
@@ -0,0 +1,476 @@
+#include <ctype.h>
+#include "f2c.h"
+#include "fio.h"
+
+extern int f__cursor;
+#ifdef KR_headers
+extern double atof();
+#else
+#undef abs
+#undef min
+#undef max
+#include <stdlib.h>
+#endif
+
+#include "fmt.h"
+#include "fp.h"
+
+ static int
+#ifdef KR_headers
+rd_Z(n,w,len) Uint *n; ftnlen len;
+#else
+rd_Z(Uint *n, int w, ftnlen len)
+#endif
+{
+	long x[9];
+	char *s, *s0, *s1, *se, *t;
+	int ch, i, w1, w2;
+	static char hex[256];
+	static int one = 1;
+	int bad = 0;
+
+	if (!hex['0']) {
+		s = "0123456789";
+		while(ch = *s++)
+			hex[ch] = ch - '0' + 1;
+		s = "ABCDEF";
+		while(ch = *s++)
+			hex[ch] = hex[ch + 'a' - 'A'] = ch - 'A' + 11;
+		}
+	s = s0 = (char *)x;
+	s1 = (char *)&x[4];
+	se = (char *)&x[8];
+	if (len > 4*sizeof(long))
+		return errno = 117;
+	while (w) {
+		GET(ch);
+		if (ch==',' || ch=='\n')
+			break;
+		w--;
+		if (ch > ' ') {
+			if (!hex[ch & 0xff])
+				bad++;
+			*s++ = ch;
+			if (s == se) {
+				/* discard excess characters */
+				for(t = s0, s = s1; t < s1;)
+					*t++ = *s++;
+				s = s1;
+				}
+			}
+		}
+	if (bad)
+		return errno = 115;
+	w = (int)len;
+	w1 = s - s0;
+	w2 = w1+1 >> 1;
+	t = (char *)n;
+	if (*(char *)&one) {
+		/* little endian */
+		t += w - 1;
+		i = -1;
+		}
+	else
+		i = 1;
+	for(; w > w2; t += i, --w)
+		*t = 0;
+	if (!w)
+		return 0;
+	if (w < w2)
+		s0 = s - (w << 1);
+	else if (w1 & 1) {
+		*t = hex[*s0++ & 0xff] - 1;
+		if (!--w)
+			return 0;
+		t += i;
+		}
+	do {
+		*t = hex[*s0 & 0xff]-1 << 4 | hex[s0[1] & 0xff]-1;
+		t += i;
+		s0 += 2;
+		}
+		while(--w);
+	return 0;
+	}
+
+ static int
+#ifdef KR_headers
+rd_I(n,w,len, base) Uint *n; int w; ftnlen len; register int base;
+#else
+rd_I(Uint *n, int w, ftnlen len, register int base)
+#endif
+{	longint x;
+	int sign,ch;
+	char s[84], *ps;
+	ps=s; x=0;
+	while (w)
+	{
+		GET(ch);
+		if (ch==',' || ch=='\n') break;
+		*ps=ch; ps++; w--;
+	}
+	*ps='\0';
+	ps=s;
+	while (*ps==' ') ps++;
+	if (*ps=='-') { sign=1; ps++; }
+	else { sign=0; if (*ps=='+') ps++; }
+loop:	while (*ps>='0' && *ps<='9') { x=x*base+(*ps-'0'); ps++; }
+	if (*ps==' ') {if (f__cblank) x *= base; ps++; goto loop;}
+	if(sign) x = -x;
+	if(len==sizeof(integer)) n->il=x;
+	else if(len == sizeof(char)) n->ic = (char)x;
+#ifdef Allow_TYQUAD
+	else if (len == sizeof(longint)) n->ili = x;
+#endif
+	else n->is = (short)x;
+	if (*ps) return(errno=115); else return(0);
+}
+ static int
+#ifdef KR_headers
+rd_L(n,w,len) ftnint *n; ftnlen len;
+#else
+rd_L(ftnint *n, int w, ftnlen len)
+#endif
+{	int ch, lv;
+	char s[84], *ps;
+	ps=s;
+	while (w) {
+		GET(ch);
+		if (ch==','||ch=='\n') break;
+		*ps=ch;
+		ps++; w--;
+		}
+	*ps='\0';
+	ps=s; while (*ps==' ') ps++;
+	if (*ps=='.') ps++;
+	if (*ps=='t' || *ps == 'T')
+		lv = 1;
+	else if (*ps == 'f' || *ps == 'F')
+		lv = 0;
+	else return(errno=116);
+	switch(len) {
+		case sizeof(char):	*(char *)n = (char)lv;	 break;
+		case sizeof(short):	*(short *)n = (short)lv; break;
+		default:		*n = lv;
+		}
+	return 0;
+}
+
+ static int
+#ifdef KR_headers
+rd_F(p, w, d, len) ufloat *p; ftnlen len;
+#else
+rd_F(ufloat *p, int w, int d, ftnlen len)
+#endif
+{
+	char s[FMAX+EXPMAXDIGS+4];
+	register int ch;
+	register char *sp, *spe, *sp1;
+	double x;
+	int scale1, se;
+	long e, exp;
+
+	sp1 = sp = s;
+	spe = sp + FMAX;
+	exp = -d;
+	x = 0.;
+
+	do {
+		GET(ch);
+		w--;
+		} while (ch == ' ' && w);
+	switch(ch) {
+		case '-': *sp++ = ch; sp1++; spe++;
+		case '+':
+			if (!w) goto zero;
+			--w;
+			GET(ch);
+		}
+	while(ch == ' ') {
+blankdrop:
+		if (!w--) goto zero; GET(ch); }
+	while(ch == '0')
+		{ if (!w--) goto zero; GET(ch); }
+	if (ch == ' ' && f__cblank)
+		goto blankdrop;
+	scale1 = f__scale;
+	while(isdigit(ch)) {
+digloop1:
+		if (sp < spe) *sp++ = ch;
+		else ++exp;
+digloop1e:
+		if (!w--) goto done;
+		GET(ch);
+		}
+	if (ch == ' ') {
+		if (f__cblank)
+			{ ch = '0'; goto digloop1; }
+		goto digloop1e;
+		}
+	if (ch == '.') {
+		exp += d;
+		if (!w--) goto done;
+		GET(ch);
+		if (sp == sp1) { /* no digits yet */
+			while(ch == '0') {
+skip01:
+				--exp;
+skip0:
+				if (!w--) goto done;
+				GET(ch);
+				}
+			if (ch == ' ') {
+				if (f__cblank) goto skip01;
+				goto skip0;
+				}
+			}
+		while(isdigit(ch)) {
+digloop2:
+			if (sp < spe)
+				{ *sp++ = ch; --exp; }
+digloop2e:
+			if (!w--) goto done;
+			GET(ch);
+			}
+		if (ch == ' ') {
+			if (f__cblank)
+				{ ch = '0'; goto digloop2; }
+			goto digloop2e;
+			}
+		}
+	switch(ch) {
+	  default:
+		break;
+	  case '-': se = 1; goto signonly;
+	  case '+': se = 0; goto signonly;
+	  case 'e':
+	  case 'E':
+	  case 'd':
+	  case 'D':
+		if (!w--)
+			goto bad;
+		GET(ch);
+		while(ch == ' ') {
+			if (!w--)
+				goto bad;
+			GET(ch);
+			}
+		se = 0;
+	  	switch(ch) {
+		  case '-': se = 1;
+		  case '+':
+signonly:
+			if (!w--)
+				goto bad;
+			GET(ch);
+			}
+		while(ch == ' ') {
+			if (!w--)
+				goto bad;
+			GET(ch);
+			}
+		if (!isdigit(ch))
+			goto bad;
+
+		e = ch - '0';
+		for(;;) {
+			if (!w--)
+				{ ch = '\n'; break; }
+			GET(ch);
+			if (!isdigit(ch)) {
+				if (ch == ' ') {
+					if (f__cblank)
+						ch = '0';
+					else continue;
+					}
+				else
+					break;
+				}
+			e = 10*e + ch - '0';
+			if (e > EXPMAX && sp > sp1)
+				goto bad;
+			}
+		if (se)
+			exp -= e;
+		else
+			exp += e;
+		scale1 = 0;
+		}
+	switch(ch) {
+	  case '\n':
+	  case ',':
+		break;
+	  default:
+bad:
+		return (errno = 115);
+		}
+done:
+	if (sp > sp1) {
+		while(*--sp == '0')
+			++exp;
+		if (exp -= scale1)
+			sprintf(sp+1, "e%ld", exp);
+		else
+			sp[1] = 0;
+		x = atof(s);
+		}
+zero:
+	if (len == sizeof(real))
+		p->pf = x;
+	else
+		p->pd = x;
+	return(0);
+	}
+
+
+ static int
+#ifdef KR_headers
+rd_A(p,len) char *p; ftnlen len;
+#else
+rd_A(char *p, ftnlen len)
+#endif
+{	int i,ch;
+	for(i=0;i<len;i++)
+	{	GET(ch);
+		*p++=VAL(ch);
+	}
+	return(0);
+}
+ static int
+#ifdef KR_headers
+rd_AW(p,w,len) char *p; ftnlen len;
+#else
+rd_AW(char *p, int w, ftnlen len)
+#endif
+{	int i,ch;
+	if(w>=len)
+	{	for(i=0;i<w-len;i++)
+			GET(ch);
+		for(i=0;i<len;i++)
+		{	GET(ch);
+			*p++=VAL(ch);
+		}
+		return(0);
+	}
+	for(i=0;i<w;i++)
+	{	GET(ch);
+		*p++=VAL(ch);
+	}
+	for(i=0;i<len-w;i++) *p++=' ';
+	return(0);
+}
+ static int
+#ifdef KR_headers
+rd_H(n,s) char *s;
+#else
+rd_H(int n, char *s)
+#endif
+{	int i,ch;
+	for(i=0;i<n;i++)
+		if((ch=(*f__getn)())<0) return(ch);
+		else *s++ = ch=='\n'?' ':ch;
+	return(1);
+}
+ static int
+#ifdef KR_headers
+rd_POS(s) char *s;
+#else
+rd_POS(char *s)
+#endif
+{	char quote;
+	int ch;
+	quote= *s++;
+	for(;*s;s++)
+		if(*s==quote && *(s+1)!=quote) break;
+		else if((ch=(*f__getn)())<0) return(ch);
+		else *s = ch=='\n'?' ':ch;
+	return(1);
+}
+#ifdef KR_headers
+rd_ed(p,ptr,len) struct syl *p; char *ptr; ftnlen len;
+#else
+rd_ed(struct syl *p, char *ptr, ftnlen len)
+#endif
+{	int ch;
+	for(;f__cursor>0;f__cursor--) if((ch=(*f__getn)())<0) return(ch);
+	if(f__cursor<0)
+	{	if(f__recpos+f__cursor < 0) /*err(elist->cierr,110,"fmt")*/
+			f__cursor = -f__recpos;	/* is this in the standard? */
+		if(f__external == 0) {
+			extern char *f__icptr;
+			f__icptr += f__cursor;
+		}
+		else if(f__curunit && f__curunit->useek)
+			(void) fseek(f__cf,(long) f__cursor,SEEK_CUR);
+		else
+			err(f__elist->cierr,106,"fmt");
+		f__recpos += f__cursor;
+		f__cursor=0;
+	}
+	switch(p->op)
+	{
+	default: fprintf(stderr,"rd_ed, unexpected code: %d\n", p->op);
+		sig_die(f__fmtbuf, 1);
+	case IM:
+	case I: ch = rd_I((Uint *)ptr,p->p1,len, 10);
+		break;
+
+		/* O and OM don't work right for character, double, complex, */
+		/* or doublecomplex, and they differ from Fortran 90 in */
+		/* showing a minus sign for negative values. */
+
+	case OM:
+	case O: ch = rd_I((Uint *)ptr, p->p1, len, 8);
+		break;
+	case L: ch = rd_L((ftnint *)ptr,p->p1,len);
+		break;
+	case A:	ch = rd_A(ptr,len);
+		break;
+	case AW:
+		ch = rd_AW(ptr,p->p1,len);
+		break;
+	case E: case EE:
+	case D:
+	case G:
+	case GE:
+	case F:	ch = rd_F((ufloat *)ptr,p->p1,p->p2,len);
+		break;
+
+		/* Z and ZM assume 8-bit bytes. */
+
+	case ZM:
+	case Z:
+		ch = rd_Z((Uint *)ptr, p->p1, len);
+		break;
+	}
+	if(ch == 0) return(ch);
+	else if(ch == EOF) return(EOF);
+	if (f__cf)
+		clearerr(f__cf);
+	return(errno);
+}
+#ifdef KR_headers
+rd_ned(p) struct syl *p;
+#else
+rd_ned(struct syl *p)
+#endif
+{
+	switch(p->op)
+	{
+	default: fprintf(stderr,"rd_ned, unexpected code: %d\n", p->op);
+		sig_die(f__fmtbuf, 1);
+	case APOS:
+		return(rd_POS(*(char **)&p->p2));
+	case H:	return(rd_H(p->p1,*(char **)&p->p2));
+	case SLASH: return((*f__donewrec)());
+	case TR:
+	case X:	f__cursor += p->p1;
+		return(1);
+	case T: f__cursor=p->p1-f__recpos - 1;
+		return(1);
+	case TL: f__cursor -= p->p1;
+		if(f__cursor < -f__recpos)	/* TL1000, 1X */
+			f__cursor = -f__recpos;
+		return(1);
+	}
+}
diff --git a/gcc/f/runtime/libI77/rewind.c b/gcc/f/runtime/libI77/rewind.c
new file mode 100644
index 00000000000..9ba4b239f32
--- /dev/null
+++ b/gcc/f/runtime/libI77/rewind.c
@@ -0,0 +1,26 @@
+#include "f2c.h"
+#include "fio.h"
+#ifdef KR_headers
+integer f_rew(a) alist *a;
+#else
+integer f_rew(alist *a)
+#endif
+{
+	unit *b;
+	if (f__init & 2)
+		f__fatal (131, "I/O recursion");
+	if(a->aunit>=MXUNIT || a->aunit<0)
+		err(a->aerr,101,"rewind");
+	b = &f__units[a->aunit];
+	if(b->ufd == NULL || b->uwrt == 3)
+		return(0);
+	if(!b->useek)
+		err(a->aerr,106,"rewind");
+	if(b->uwrt) {
+		(void) t_runc(a);
+		b->uwrt = 3;
+		}
+	rewind(b->ufd);
+	b->uend=0;
+	return(0);
+}
diff --git a/gcc/f/runtime/libI77/rsfe.c b/gcc/f/runtime/libI77/rsfe.c
new file mode 100644
index 00000000000..02a9e6d4680
--- /dev/null
+++ b/gcc/f/runtime/libI77/rsfe.c
@@ -0,0 +1,80 @@
+/* read sequential formatted external */
+#include "f2c.h"
+#include "fio.h"
+#include "fmt.h"
+
+xrd_SL(Void)
+{	int ch;
+	if(!f__curunit->uend)
+		while((ch=getc(f__cf))!='\n')
+			if (ch == EOF) {
+				f__curunit->uend = 1;
+				break;
+				}
+	f__cursor=f__recpos=0;
+	return(1);
+}
+x_getc(Void)
+{	int ch;
+	if(f__curunit->uend) return(EOF);
+	ch = getc(f__cf);
+	if(ch!=EOF && ch!='\n')
+	{	f__recpos++;
+		return(ch);
+	}
+	if(ch=='\n')
+	{	(void) ungetc(ch,f__cf);
+		return(ch);
+	}
+	if(f__curunit->uend || feof(f__cf))
+	{	errno=0;
+		f__curunit->uend=1;
+		return(-1);
+	}
+	return(-1);
+}
+x_endp(Void)
+{
+	xrd_SL();
+	return f__curunit->uend == 1 ? EOF : 0;
+}
+x_rev(Void)
+{
+	(void) xrd_SL();
+	return(0);
+}
+#ifdef KR_headers
+integer s_rsfe(a) cilist *a; /* start */
+#else
+integer s_rsfe(cilist *a) /* start */
+#endif
+{	int n;
+	if(f__init != 1) f_init();
+	f__init = 3;
+	if(n=c_sfe(a)) return(n);
+	f__reading=1;
+	f__sequential=1;
+	f__formatted=1;
+	f__external=1;
+	f__elist=a;
+	f__cursor=f__recpos=0;
+	f__scale=0;
+	f__fmtbuf=a->cifmt;
+	f__curunit= &f__units[a->ciunit];
+	f__cf=f__curunit->ufd;
+	if(pars_f(f__fmtbuf)<0) err(a->cierr,100,"startio");
+	f__getn= x_getc;
+	f__doed= rd_ed;
+	f__doned= rd_ned;
+	fmt_bg();
+	f__doend=x_endp;
+	f__donewrec=xrd_SL;
+	f__dorevert=x_rev;
+	f__cblank=f__curunit->ublnk;
+	f__cplus=0;
+	if(f__curunit->uwrt && f__nowreading(f__curunit))
+		err(a->cierr,errno,"read start");
+	if(f__curunit->uend)
+		err(f__elist->ciend,(EOF),"read start");
+	return(0);
+}
diff --git a/gcc/f/runtime/libI77/rsli.c b/gcc/f/runtime/libI77/rsli.c
new file mode 100644
index 00000000000..baf2ba54873
--- /dev/null
+++ b/gcc/f/runtime/libI77/rsli.c
@@ -0,0 +1,105 @@
+#include "f2c.h"
+#include "fio.h"
+#include "lio.h"
+#include "fmt.h" /* for f__doend */
+
+extern flag f__lquit;
+extern int f__lcount;
+extern char *f__icptr;
+extern char *f__icend;
+extern icilist *f__svic;
+extern int f__icnum, f__recpos;
+
+static int i_getc(Void)
+{
+	if(f__recpos >= f__svic->icirlen) {
+		if (f__recpos++ == f__svic->icirlen)
+			return '\n';
+		z_rnew();
+		}
+	f__recpos++;
+	if(f__icptr >= f__icend)
+		return EOF;
+	return(*f__icptr++);
+	}
+
+ static
+#ifdef KR_headers
+int i_ungetc(ch, f) int ch; FILE *f;
+#else
+int i_ungetc(int ch, FILE *f)
+#endif
+{
+	if (--f__recpos == f__svic->icirlen)
+		return '\n';
+	if (f__recpos < -1)
+		err(f__svic->icierr,110,"recend");
+	/* *--icptr == ch, and icptr may point to read-only memory */
+	return *--f__icptr /* = ch */;
+	}
+
+ static void
+#ifdef KR_headers
+c_lir(a) icilist *a;
+#else
+c_lir(icilist *a)
+#endif
+{
+	extern int l_eof;
+	if(f__init != 1) f_init();
+	f__init = 3;
+	f__reading = 1;
+	f__external = 0;
+	f__formatted = 1;
+	f__svic = a;
+	L_len = a->icirlen;
+	f__recpos = -1;
+	f__icnum = f__recpos = 0;
+	f__cursor = 0;
+	l_getc = i_getc;
+	l_ungetc = i_ungetc;
+	l_eof = 0;
+	f__icptr = a->iciunit;
+	f__icend = f__icptr + a->icirlen*a->icirnum;
+	f__cf = 0;
+	f__curunit = 0;
+	f__elist = (cilist *)a;
+	}
+
+
+#ifdef KR_headers
+integer s_rsli(a) icilist *a;
+#else
+integer s_rsli(icilist *a)
+#endif
+{
+	f__lioproc = l_read;
+	f__lquit = 0;
+	f__lcount = 0;
+	c_lir(a);
+	f__doend = 0;
+	return(0);
+	}
+
+integer e_rsli(Void)
+{ f__init = 1; return 0; }
+
+#ifdef KR_headers
+integer s_rsni(a) icilist *a;
+#else
+extern int x_rsne(cilist*);
+
+integer s_rsni(icilist *a)
+#endif
+{
+	extern int nml_read;
+	integer rv;
+	cilist ca;
+	ca.ciend = a->iciend;
+	ca.cierr = a->icierr;
+	ca.cifmt = a->icifmt;
+	c_lir(a);
+	rv = x_rsne(&ca);
+	nml_read = 0;
+	return rv;
+	}
diff --git a/gcc/f/runtime/libI77/rsne.c b/gcc/f/runtime/libI77/rsne.c
new file mode 100644
index 00000000000..86bb2164f12
--- /dev/null
+++ b/gcc/f/runtime/libI77/rsne.c
@@ -0,0 +1,607 @@
+#include "f2c.h"
+#include "fio.h"
+#include "lio.h"
+
+#define MAX_NL_CACHE 3	/* maximum number of namelist hash tables to cache */
+#define MAXDIM 20	/* maximum number of subscripts */
+
+ struct dimen {
+	ftnlen extent;
+	ftnlen curval;
+	ftnlen delta;
+	ftnlen stride;
+	};
+ typedef struct dimen dimen;
+
+ struct hashentry {
+	struct hashentry *next;
+	char *name;
+	Vardesc *vd;
+	};
+ typedef struct hashentry hashentry;
+
+ struct hashtab {
+	struct hashtab *next;
+	Namelist *nl;
+	int htsize;
+	hashentry *tab[1];
+	};
+ typedef struct hashtab hashtab;
+
+ static hashtab *nl_cache;
+ static int n_nlcache;
+ static hashentry **zot;
+ static int colonseen;
+ extern ftnlen f__typesize[];
+
+ extern flag f__lquit;
+ extern int f__lcount, nml_read;
+ extern t_getc(Void);
+
+#ifdef KR_headers
+ extern char *malloc(), *memset();
+
+#ifdef ungetc
+ static int
+un_getc(x,f__cf) int x; FILE *f__cf;
+{ return ungetc(x,f__cf); }
+#else
+#define un_getc ungetc
+ extern int ungetc();
+#endif
+
+#else
+#undef abs
+#undef min
+#undef max
+#include <stdlib.h>
+#include <string.h>
+
+#ifdef ungetc
+ static int
+un_getc(int x, FILE *f__cf)
+{ return ungetc(x,f__cf); }
+#else
+#define un_getc ungetc
+extern int ungetc(int, FILE*);	/* for systems with a buggy stdio.h */
+#endif
+#endif
+
+ static Vardesc *
+#ifdef KR_headers
+hash(ht, s) hashtab *ht; register char *s;
+#else
+hash(hashtab *ht, register char *s)
+#endif
+{
+	register int c, x;
+	register hashentry *h;
+	char *s0 = s;
+
+	for(x = 0; c = *s++; x = x & 0x4000 ? ((x << 1) & 0x7fff) + 1 : x << 1)
+		x += c;
+	for(h = *(zot = ht->tab + x % ht->htsize); h; h = h->next)
+		if (!strcmp(s0, h->name))
+			return h->vd;
+	return 0;
+	}
+
+ hashtab *
+#ifdef KR_headers
+mk_hashtab(nl) Namelist *nl;
+#else
+mk_hashtab(Namelist *nl)
+#endif
+{
+	int nht, nv;
+	hashtab *ht;
+	Vardesc *v, **vd, **vde;
+	hashentry *he;
+
+	hashtab **x, **x0, *y;
+	for(x = &nl_cache; y = *x; x0 = x, x = &y->next)
+		if (nl == y->nl)
+			return y;
+	if (n_nlcache >= MAX_NL_CACHE) {
+		/* discard least recently used namelist hash table */
+		y = *x0;
+		free((char *)y->next);
+		y->next = 0;
+		}
+	else
+		n_nlcache++;
+	nv = nl->nvars;
+	if (nv >= 0x4000)
+		nht = 0x7fff;
+	else {
+		for(nht = 1; nht < nv; nht <<= 1);
+		nht += nht - 1;
+		}
+	ht = (hashtab *)malloc(sizeof(hashtab) + (nht-1)*sizeof(hashentry *)
+				+ nv*sizeof(hashentry));
+	if (!ht)
+		return 0;
+	he = (hashentry *)&ht->tab[nht];
+	ht->nl = nl;
+	ht->htsize = nht;
+	ht->next = nl_cache;
+	nl_cache = ht;
+	memset((char *)ht->tab, 0, nht*sizeof(hashentry *));
+	vd = nl->vars;
+	vde = vd + nv;
+	while(vd < vde) {
+		v = *vd++;
+		if (!hash(ht, v->name)) {
+			he->next = *zot;
+			*zot = he;
+			he->name = v->name;
+			he->vd = v;
+			he++;
+			}
+		}
+	return ht;
+	}
+
+static char Alpha[256], Alphanum[256];
+
+ static VOID
+nl_init(Void) {
+	register char *s;
+	register int c;
+
+	for(s = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; c = *s++; )
+		Alpha[c]
+		= Alphanum[c]
+		= Alpha[c + 'a' - 'A']
+		= Alphanum[c + 'a' - 'A']
+		= c;
+	for(s = "0123456789_"; c = *s++; )
+		Alphanum[c] = c;
+	}
+
+#define GETC(x) (x=(*l_getc)())
+#define Ungetc(x,y) (*l_ungetc)(x,y)
+
+ static int
+#ifdef KR_headers
+getname(s, slen) register char *s; int slen;
+#else
+getname(register char *s, int slen)
+#endif
+{
+	register char *se = s + slen - 1;
+	register int ch;
+
+	GETC(ch);
+	if (!(*s++ = Alpha[ch & 0xff])) {
+		if (ch != EOF)
+			ch = 115;
+		errfl(f__elist->cierr, ch, "namelist read");
+		}
+	while(*s = Alphanum[GETC(ch) & 0xff])
+		if (s < se)
+			s++;
+	if (ch == EOF)
+		err(f__elist->cierr, EOF, "namelist read");
+	if (ch > ' ')
+		Ungetc(ch,f__cf);
+	return *s = 0;
+	}
+
+ static int
+#ifdef KR_headers
+getnum(chp, val) int *chp; ftnlen *val;
+#else
+getnum(int *chp, ftnlen *val)
+#endif
+{
+	register int ch, sign;
+	register ftnlen x;
+
+	while(GETC(ch) <= ' ' && ch >= 0);
+	if (ch == '-') {
+		sign = 1;
+		GETC(ch);
+		}
+	else {
+		sign = 0;
+		if (ch == '+')
+			GETC(ch);
+		}
+	x = ch - '0';
+	if (x < 0 || x > 9)
+		return 115;
+	while(GETC(ch) >= '0' && ch <= '9')
+		x = 10*x + ch - '0';
+	while(ch <= ' ' && ch >= 0)
+		GETC(ch);
+	if (ch == EOF)
+		return EOF;
+	*val = sign ? -x : x;
+	*chp = ch;
+	return 0;
+	}
+
+ static int
+#ifdef KR_headers
+getdimen(chp, d, delta, extent, x1)
+ int *chp; dimen *d; ftnlen delta, extent, *x1;
+#else
+getdimen(int *chp, dimen *d, ftnlen delta, ftnlen extent, ftnlen *x1)
+#endif
+{
+	register int k;
+	ftnlen x2, x3;
+
+	if (k = getnum(chp, x1))
+		return k;
+	x3 = 1;
+	if (*chp == ':') {
+		if (k = getnum(chp, &x2))
+			return k;
+		x2 -= *x1;
+		if (*chp == ':') {
+			if (k = getnum(chp, &x3))
+				return k;
+			if (!x3)
+				return 123;
+			x2 /= x3;
+			colonseen = 1;
+			}
+		if (x2 < 0 || x2 >= extent)
+			return 123;
+		d->extent = x2 + 1;
+		}
+	else
+		d->extent = 1;
+	d->curval = 0;
+	d->delta = delta;
+	d->stride = x3;
+	return 0;
+	}
+
+#ifndef No_Namelist_Questions
+ static Void
+#ifdef KR_headers
+print_ne(a) cilist *a;
+#else
+print_ne(cilist *a)
+#endif
+{
+	flag intext = f__external;
+	int rpsave = f__recpos;
+	FILE *cfsave = f__cf;
+	unit *usave = f__curunit;
+	cilist t;
+	t = *a;
+	t.ciunit = 6;
+	s_wsne(&t);
+	fflush(f__cf);
+	f__external = intext;
+	f__reading = 1;
+	f__recpos = rpsave;
+	f__cf = cfsave;
+	f__curunit = usave;
+	f__elist = a;
+	}
+#endif
+
+ static char where0[] = "namelist read start ";
+
+#ifdef KR_headers
+x_rsne(a) cilist *a;
+#else
+x_rsne(cilist *a)
+#endif
+{
+	int ch, got1, k, n, nd, quote, readall;
+	Namelist *nl;
+	static char where[] = "namelist read";
+	char buf[64];
+	hashtab *ht;
+	Vardesc *v;
+	dimen *dn, *dn0, *dn1;
+	ftnlen *dims, *dims1;
+	ftnlen b, b0, b1, ex, no, no1, nomax, size, span;
+	ftnint type;
+	char *vaddr;
+	long iva, ivae;
+	dimen dimens[MAXDIM], substr;
+
+	if (!Alpha['a'])
+		nl_init();
+	f__reading=1;
+	f__formatted=1;
+	got1 = 0;
+ top:
+	for(;;) switch(GETC(ch)) {
+		case EOF:
+ eof:
+			err(a->ciend,(EOF),where0);
+		case '&':
+		case '$':
+			goto have_amp;
+#ifndef No_Namelist_Questions
+		case '?':
+			print_ne(a);
+			continue;
+#endif
+		default:
+			if (ch <= ' ' && ch >= 0)
+				continue;
+#ifndef No_Namelist_Comments
+			while(GETC(ch) != '\n')
+				if (ch == EOF)
+					goto eof;
+#else
+			errfl(a->cierr, 115, where0);
+#endif
+		}
+ have_amp:
+	if (ch = getname(buf,(int) sizeof(buf)))
+		return ch;
+	nl = (Namelist *)a->cifmt;
+	if (strcmp(buf, nl->name))
+#ifdef No_Bad_Namelist_Skip
+		errfl(a->cierr, 118, where0);
+#else
+	{
+		fprintf(stderr,
+			"Skipping namelist \"%s\": seeking namelist \"%s\".\n",
+			buf, nl->name);
+		fflush(stderr);
+		for(;;) switch(GETC(ch)) {
+			case EOF:
+				err(a->ciend, EOF, where0);
+			case '/':
+			case '&':
+			case '$':
+				if (f__external)
+					e_rsle();
+				else
+					z_rnew();
+				goto top;
+			case '"':
+			case '\'':
+				quote = ch;
+ more_quoted:
+				while(GETC(ch) != quote)
+					if (ch == EOF)
+						err(a->ciend, EOF, where0);
+				if (GETC(ch) == quote)
+					goto more_quoted;
+				Ungetc(ch,f__cf);
+			default:
+				continue;
+			}
+		}
+#endif
+	ht = mk_hashtab(nl);
+	if (!ht)
+		errfl(f__elist->cierr, 113, where0);
+	for(;;) {
+		for(;;) switch(GETC(ch)) {
+			case EOF:
+				if (got1)
+					return 0;
+				err(a->ciend, EOF, where0);
+			case '/':
+			case '$':
+			case '&':
+				return 0;
+			default:
+				if (ch <= ' ' && ch >= 0 || ch == ',')
+					continue;
+				Ungetc(ch,f__cf);
+				if (ch = getname(buf,(int) sizeof(buf)))
+					return ch;
+				goto havename;
+			}
+ havename:
+		v = hash(ht,buf);
+		if (!v)
+			errfl(a->cierr, 119, where);
+		while(GETC(ch) <= ' ' && ch >= 0);
+		vaddr = v->addr;
+		type = v->type;
+		if (type < 0) {
+			size = -type;
+			type = TYCHAR;
+			}
+		else
+			size = f__typesize[type];
+		ivae = size;
+		iva = readall = 0;
+		if (ch == '(' /*)*/ ) {
+			dn = dimens;
+			if (!(dims = v->dims)) {
+				if (type != TYCHAR)
+					errfl(a->cierr, 122, where);
+				if (k = getdimen(&ch, dn, (ftnlen)size,
+						(ftnlen)size, &b))
+					errfl(a->cierr, k, where);
+				if (ch != ')')
+					errfl(a->cierr, 115, where);
+				b1 = dn->extent;
+				if (--b < 0 || b + b1 > size)
+					return 124;
+				iva += b;
+				size = b1;
+				while(GETC(ch) <= ' ' && ch >= 0);
+				goto scalar;
+				}
+			nd = (int)dims[0];
+			nomax = span = dims[1];
+			ivae = iva + size*nomax;
+			colonseen = 0;
+			if (k = getdimen(&ch, dn, size, nomax, &b))
+				errfl(a->cierr, k, where);
+			no = dn->extent;
+			b0 = dims[2];
+			dims1 = dims += 3;
+			ex = 1;
+			for(n = 1; n++ < nd; dims++) {
+				if (ch != ',')
+					errfl(a->cierr, 115, where);
+				dn1 = dn + 1;
+				span /= *dims;
+				if (k = getdimen(&ch, dn1, dn->delta**dims,
+						span, &b1))
+					errfl(a->cierr, k, where);
+				ex *= *dims;
+				b += b1*ex;
+				no *= dn1->extent;
+				dn = dn1;
+				}
+			if (ch != ')')
+				errfl(a->cierr, 115, where);
+			readall = 1 - colonseen;
+			b -= b0;
+			if (b < 0 || b >= nomax)
+				errfl(a->cierr, 125, where);
+			iva += size * b;
+			dims = dims1;
+			while(GETC(ch) <= ' ' && ch >= 0);
+			no1 = 1;
+			dn0 = dimens;
+			if (type == TYCHAR && ch == '(' /*)*/) {
+				if (k = getdimen(&ch, &substr, size, size, &b))
+					errfl(a->cierr, k, where);
+				if (ch != ')')
+					errfl(a->cierr, 115, where);
+				b1 = substr.extent;
+				if (--b < 0 || b + b1 > size)
+					return 124;
+				iva += b;
+				b0 = size;
+				size = b1;
+				while(GETC(ch) <= ' ' && ch >= 0);
+				if (b1 < b0)
+					goto delta_adj;
+				}
+			if (readall)
+				goto delta_adj;
+			for(; dn0 < dn; dn0++) {
+				if (dn0->extent != *dims++ || dn0->stride != 1)
+					break;
+				no1 *= dn0->extent;
+				}
+			if (dn0 == dimens && dimens[0].stride == 1) {
+				no1 = dimens[0].extent;
+				dn0++;
+				}
+ delta_adj:
+			ex = 0;
+			for(dn1 = dn0; dn1 <= dn; dn1++)
+				ex += (dn1->extent-1)
+					* (dn1->delta *= dn1->stride);
+			for(dn1 = dn; dn1 > dn0; dn1--) {
+				ex -= (dn1->extent - 1) * dn1->delta;
+				dn1->delta -= ex;
+				}
+			}
+		else if (dims = v->dims) {
+			no = no1 = dims[1];
+			ivae = iva + no*size;
+			}
+		else
+ scalar:
+			no = no1 = 1;
+		if (ch != '=')
+			errfl(a->cierr, 115, where);
+		got1 = nml_read = 1;
+		f__lcount = 0;
+	 readloop:
+		for(;;) {
+			if (iva >= ivae || iva < 0) {
+				f__lquit = 1;
+				goto mustend;
+				}
+			else if (iva + no1*size > ivae)
+				no1 = (ivae - iva)/size;
+			f__lquit = 0;
+			if (k = l_read(&no1, vaddr + iva, size, type))
+				return k;
+			if (f__lquit == 1)
+				return 0;
+			if (readall) {
+				iva += dn0->delta;
+				if (f__lcount > 0) {
+					no1 = (ivae - iva)/size;
+					if (no1 > f__lcount)
+						no1 = f__lcount;
+					iva += no1 * dn0->delta;
+					if (k = l_read(&no1, vaddr + iva,
+							size, type))
+						return k;
+					}
+				}
+ mustend:
+			GETC(ch);
+			if (readall)
+				if (iva >= ivae)
+					readall = 0;
+				else for(;;) {
+					switch(ch) {
+						case ' ':
+						case '\t':
+						case '\n':
+							GETC(ch);
+							continue;
+						}
+					break;
+					}
+			if (ch == '/' || ch == '$' || ch == '&') {
+				f__lquit = 1;
+				return 0;
+				}
+			else if (f__lquit) {
+				while(ch <= ' ' && ch >= 0)
+					GETC(ch);
+				Ungetc(ch,f__cf);
+				if (!Alpha[ch & 0xff] && ch >= 0)
+					errfl(a->cierr, 125, where);
+				break;
+				}
+			Ungetc(ch,f__cf);
+			if (readall && !Alpha[ch & 0xff])
+				goto readloop;
+			if ((no -= no1) <= 0)
+				break;
+			for(dn1 = dn0; dn1 <= dn; dn1++) {
+				if (++dn1->curval < dn1->extent) {
+					iva += dn1->delta;
+					goto readloop;
+					}
+				dn1->curval = 0;
+				}
+			break;
+			}
+		}
+	}
+
+ integer
+#ifdef KR_headers
+s_rsne(a) cilist *a;
+#else
+s_rsne(cilist *a)
+#endif
+{
+	extern int l_eof;
+	int n;
+
+	f__external=1;
+	l_eof = 0;
+	if(n = c_le(a))
+		return n;
+	if(f__curunit->uwrt && f__nowreading(f__curunit))
+		err(a->cierr,errno,where0);
+	l_getc = t_getc;
+	l_ungetc = un_getc;
+	f__doend = xrd_SL;
+	n = x_rsne(a);
+	nml_read = 0;
+	if (n)
+		return n;
+	return e_rsle();
+	}
diff --git a/gcc/f/runtime/libI77/sfe.c b/gcc/f/runtime/libI77/sfe.c
new file mode 100644
index 00000000000..1bb10d9052d
--- /dev/null
+++ b/gcc/f/runtime/libI77/sfe.c
@@ -0,0 +1,44 @@
+/* sequential formatted external common routines*/
+#include "f2c.h"
+#include "fio.h"
+
+extern char *f__fmtbuf;
+
+integer e_rsfe(Void)
+{	int n;
+	f__init = 1;
+	n=en_fio();
+	if (f__cf == stdout)
+		fflush(stdout);
+	else if (f__cf == stderr)
+		fflush(stderr);
+	f__fmtbuf=NULL;
+	return(n);
+}
+#ifdef KR_headers
+c_sfe(a) cilist *a; /* check */
+#else
+c_sfe(cilist *a) /* check */
+#endif
+{	unit *p;
+	if(a->ciunit >= MXUNIT || a->ciunit<0)
+		err(a->cierr,101,"startio");
+	p = &f__units[a->ciunit];
+	if(p->ufd==NULL && fk_open(SEQ,FMT,a->ciunit)) err(a->cierr,114,"sfe");
+	if(!p->ufmt) err(a->cierr,102,"sfe");
+	return(0);
+}
+integer e_wsfe(Void)
+{
+#ifdef ALWAYS_FLUSH
+	int n;
+	f__init = 1;
+	n = en_fio();
+	f__fmtbuf=NULL;
+	if (!n && fflush(f__cf))
+		err(f__elist->cierr, errno, "write end");
+	return n;
+#else
+	return(e_rsfe());
+#endif
+}
diff --git a/gcc/f/runtime/libI77/sue.c b/gcc/f/runtime/libI77/sue.c
new file mode 100644
index 00000000000..8f2ea314f30
--- /dev/null
+++ b/gcc/f/runtime/libI77/sue.c
@@ -0,0 +1,87 @@
+#include "f2c.h"
+#include "fio.h"
+extern uiolen f__reclen;
+long f__recloc;
+
+#ifdef KR_headers
+c_sue(a) cilist *a;
+#else
+c_sue(cilist *a)
+#endif
+{
+	if(a->ciunit >= MXUNIT || a->ciunit < 0)
+		err(a->cierr,101,"startio");
+	f__external=f__sequential=1;
+	f__formatted=0;
+	f__curunit = &f__units[a->ciunit];
+	f__elist=a;
+	if(f__curunit->ufd==NULL && fk_open(SEQ,UNF,a->ciunit))
+		err(a->cierr,114,"sue");
+	f__cf=f__curunit->ufd;
+	if(f__curunit->ufmt) err(a->cierr,103,"sue");
+	if(!f__curunit->useek) err(a->cierr,103,"sue");
+	return(0);
+}
+#ifdef KR_headers
+integer s_rsue(a) cilist *a;
+#else
+integer s_rsue(cilist *a)
+#endif
+{
+	int n;
+	if(f__init != 1) f_init();
+	f__init = 3;
+	f__reading=1;
+	if(n=c_sue(a)) return(n);
+	f__recpos=0;
+	if(f__curunit->uwrt && f__nowreading(f__curunit))
+		err(a->cierr, errno, "read start");
+	if(fread((char *)&f__reclen,sizeof(uiolen),1,f__cf)
+		!= 1)
+	{	if(feof(f__cf))
+		{	f__curunit->uend = 1;
+			err(a->ciend, EOF, "start");
+		}
+		clearerr(f__cf);
+		err(a->cierr, errno, "start");
+	}
+	return(0);
+}
+#ifdef KR_headers
+integer s_wsue(a) cilist *a;
+#else
+integer s_wsue(cilist *a)
+#endif
+{
+	int n;
+	if(f__init != 1) f_init();
+	f__init = 3;
+	if(n=c_sue(a)) return(n);
+	f__reading=0;
+	f__reclen=0;
+	if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit))
+		err(a->cierr, errno, "write start");
+	f__recloc=ftell(f__cf);
+	(void) fseek(f__cf,(long)sizeof(uiolen),SEEK_CUR);
+	return(0);
+}
+integer e_wsue(Void)
+{	long loc;
+	f__init = 1;
+	fwrite((char *)&f__reclen,sizeof(uiolen),1,f__cf);
+#ifdef ALWAYS_FLUSH
+	if (fflush(f__cf))
+		err(f__elist->cierr, errno, "write end");
+#endif
+	loc=ftell(f__cf);
+	fseek(f__cf,f__recloc,SEEK_SET);
+	fwrite((char *)&f__reclen,sizeof(uiolen),1,f__cf);
+	fseek(f__cf,loc,SEEK_SET);
+	return(0);
+}
+integer e_rsue(Void)
+{
+	f__init = 1;
+	(void) fseek(f__cf,(long)(f__reclen-f__recpos+sizeof(uiolen)),SEEK_CUR);
+	return(0);
+}
diff --git a/gcc/f/runtime/libI77/typesize.c b/gcc/f/runtime/libI77/typesize.c
new file mode 100644
index 00000000000..1cb20ff2863
--- /dev/null
+++ b/gcc/f/runtime/libI77/typesize.c
@@ -0,0 +1,12 @@
+#include "f2c.h"
+
+ftnlen f__typesize[] = { 0, 0, sizeof(shortint), sizeof(integer),
+			sizeof(real), sizeof(doublereal),
+			sizeof(complex), sizeof(doublecomplex),
+			sizeof(logical), sizeof(char),
+			0, sizeof(integer1),
+			sizeof(logical1), sizeof(shortlogical),
+#ifdef Allow_TYQUAD
+			sizeof(longint),
+#endif
+			0};
diff --git a/gcc/f/runtime/libI77/uio.c b/gcc/f/runtime/libI77/uio.c
new file mode 100644
index 00000000000..ea733cec06c
--- /dev/null
+++ b/gcc/f/runtime/libI77/uio.c
@@ -0,0 +1,69 @@
+#include "f2c.h"
+#include "fio.h"
+#include <sys/types.h>
+uiolen f__reclen;
+
+#ifdef KR_headers
+do_us(number,ptr,len) ftnint *number; char *ptr; ftnlen len;
+#else
+do_us(ftnint *number, char *ptr, ftnlen len)
+#endif
+{
+	if(f__reading)
+	{
+		f__recpos += (int)(*number * len);
+		if(f__recpos>f__reclen)
+			err(f__elist->cierr, 110, "do_us");
+		if (fread(ptr,(size_t)len,(size_t)(*number),f__cf) != *number)
+			err(f__elist->ciend, EOF, "do_us");
+		return(0);
+	}
+	else
+	{
+		f__reclen += *number * len;
+		(void) fwrite(ptr,(size_t)len,(size_t)(*number),f__cf);
+		return(0);
+	}
+}
+#ifdef KR_headers
+integer do_ud(number,ptr,len) ftnint *number; char *ptr; ftnlen len;
+#else
+integer do_ud(ftnint *number, char *ptr, ftnlen len)
+#endif
+{
+	f__recpos += (int)(*number * len);
+	if(f__recpos > f__curunit->url && f__curunit->url!=1)
+		err(f__elist->cierr,110,"do_ud");
+	if(f__reading)
+	{
+#ifdef Pad_UDread
+#ifdef KR_headers
+	int i;
+#else
+	size_t i;
+#endif
+		if (!(i = fread(ptr,(size_t)len,(size_t)(*number),f__cf))
+		 && !(f__recpos - *number*len))
+			err(f__elist->cierr,EOF,"do_ud");
+		if (i < *number)
+			memset(ptr + i*len, 0, (*number - i)*len);
+		return 0;
+#else
+		if(fread(ptr,(size_t)len,(size_t)(*number),f__cf) != *number)
+			err(f__elist->cierr,EOF,"do_ud");
+		else return(0);
+#endif
+	}
+	(void) fwrite(ptr,(size_t)len,(size_t)(*number),f__cf);
+	return(0);
+}
+#ifdef KR_headers
+integer do_uio(number,ptr,len) ftnint *number; char *ptr; ftnlen len;
+#else
+integer do_uio(ftnint *number, char *ptr, ftnlen len)
+#endif
+{
+	if(f__sequential)
+		return(do_us(number,ptr,len));
+	else	return(do_ud(number,ptr,len));
+}
diff --git a/gcc/f/runtime/libI77/util.c b/gcc/f/runtime/libI77/util.c
new file mode 100644
index 00000000000..a24932533c1
--- /dev/null
+++ b/gcc/f/runtime/libI77/util.c
@@ -0,0 +1,51 @@
+#ifndef NON_UNIX_STDIO
+#include <sys/types.h>
+#include <sys/stat.h>
+#endif
+#include "f2c.h"
+#include "fio.h"
+
+ VOID
+#ifdef KR_headers
+g_char(a,alen,b) char *a,*b; ftnlen alen;
+#else
+g_char(char *a, ftnlen alen, char *b)
+#endif
+{
+	char *x = a + alen, *y = b + alen;
+
+	for(;; y--) {
+		if (x <= a) {
+			*b = 0;
+			return;
+			}
+		if (*--x != ' ')
+			break;
+		}
+	*y-- = 0;
+	do *y-- = *x;
+		while(x-- > a);
+	}
+
+ VOID
+#ifdef KR_headers
+b_char(a,b,blen) char *a,*b; ftnlen blen;
+#else
+b_char(char *a, char *b, ftnlen blen)
+#endif
+{	int i;
+	for(i=0;i<blen && *a!=0;i++) *b++= *a++;
+	for(;i<blen;i++) *b++=' ';
+}
+#ifndef NON_UNIX_STDIO
+#ifdef KR_headers
+long f__inode(a, dev) char *a; int *dev;
+#else
+long f__inode(char *a, int *dev)
+#endif
+{	struct stat x;
+	if(stat(a,&x)<0) return(-1);
+	*dev = x.st_dev;
+	return(x.st_ino);
+}
+#endif
diff --git a/gcc/f/runtime/libI77/wref.c b/gcc/f/runtime/libI77/wref.c
new file mode 100644
index 00000000000..a10bcaa1236
--- /dev/null
+++ b/gcc/f/runtime/libI77/wref.c
@@ -0,0 +1,276 @@
+#include "f2c.h"
+#include "fio.h"
+#ifndef VAX
+#include <ctype.h>
+#endif
+
+#ifndef KR_headers
+#undef abs
+#undef min
+#undef max
+#include <stdlib.h>
+#include <string.h>
+#endif
+
+#include "fmt.h"
+#include "fp.h"
+
+#ifdef KR_headers
+wrt_E(p,w,d,e,len) ufloat *p; ftnlen len;
+#else
+wrt_E(ufloat *p, int w, int d, int e, ftnlen len)
+#endif
+{
+	char buf[FMAX+EXPMAXDIGS+4], *s, *se;
+	int d1, delta, e1, i, sign, signspace;
+	double dd;
+#ifdef WANT_LEAD_0
+	int insert0 = 0;
+#endif
+#ifndef VAX
+	int e0 = e;
+#endif
+
+	if(e <= 0)
+		e = 2;
+	if(f__scale) {
+		if(f__scale >= d + 2 || f__scale <= -d)
+			goto nogood;
+		}
+	if(f__scale <= 0)
+		--d;
+	if (len == sizeof(real))
+		dd = p->pf;
+	else
+		dd = p->pd;
+	if (dd < 0.) {
+		signspace = sign = 1;
+		dd = -dd;
+		}
+	else {
+		sign = 0;
+		signspace = (int)f__cplus;
+#ifndef VAX
+		if (!dd)
+			dd = 0.;	/* avoid -0 */
+#endif
+		}
+	delta = w - (2 /* for the . and the d adjustment above */
+			+ 2 /* for the E+ */ + signspace + d + e);
+#ifdef WANT_LEAD_0
+	if (f__scale <= 0 && delta > 0) {
+		delta--;
+		insert0 = 1;
+		}
+	else
+#endif
+	if (delta < 0) {
+nogood:
+		while(--w >= 0)
+			PUT('*');
+		return(0);
+		}
+	if (f__scale < 0)
+		d += f__scale;
+	if (d > FMAX) {
+		d1 = d - FMAX;
+		d = FMAX;
+		}
+	else
+		d1 = 0;
+	sprintf(buf,"%#.*E", d, dd);
+#ifndef VAX
+	/* check for NaN, Infinity */
+	if (!isdigit(buf[0])) {
+		switch(buf[0]) {
+			case 'n':
+			case 'N':
+				signspace = 0;	/* no sign for NaNs */
+			}
+		delta = w - strlen(buf) - signspace;
+		if (delta < 0)
+			goto nogood;
+		while(--delta >= 0)
+			PUT(' ');
+		if (signspace)
+			PUT(sign ? '-' : '+');
+		for(s = buf; *s; s++)
+			PUT(*s);
+		return 0;
+		}
+#endif
+	se = buf + d + 3;
+#ifdef GOOD_SPRINTF_EXPONENT /* When possible, exponent has 2 digits. */
+	if (f__scale != 1 && dd)
+		sprintf(se, "%+.2d", atoi(se) + 1 - f__scale);
+#else
+	if (dd)
+		sprintf(se, "%+.2d", atoi(se) + 1 - f__scale);
+	else
+		strcpy(se, "+00");
+#endif
+	s = ++se;
+	if (e < 2) {
+		if (*s != '0')
+			goto nogood;
+		}
+#ifndef VAX
+	/* accommodate 3 significant digits in exponent */
+	if (s[2]) {
+#ifdef Pedantic
+		if (!e0 && !s[3])
+			for(s -= 2, e1 = 2; s[0] = s[1]; s++);
+
+	/* Pedantic gives the behavior that Fortran 77 specifies,	*/
+	/* i.e., requires that E be specified for exponent fields	*/
+	/* of more than 3 digits.  With Pedantic undefined, we get	*/
+	/* the behavior that Cray displays -- you get a bigger		*/
+	/* exponent field if it fits.	*/
+#else
+		if (!e0) {
+			for(s -= 2, e1 = 2; s[0] = s[1]; s++)
+#ifdef CRAY
+				delta--;
+			if ((delta += 4) < 0)
+				goto nogood
+#endif
+				;
+			}
+#endif
+		else if (e0 >= 0)
+			goto shift;
+		else
+			e1 = e;
+		}
+	else
+ shift:
+#endif
+		for(s += 2, e1 = 2; *s; ++e1, ++s)
+			if (e1 >= e)
+				goto nogood;
+	while(--delta >= 0)
+		PUT(' ');
+	if (signspace)
+		PUT(sign ? '-' : '+');
+	s = buf;
+	i = f__scale;
+	if (f__scale <= 0) {
+#ifdef WANT_LEAD_0
+		if (insert0)
+			PUT('0');
+#endif
+		PUT('.');
+		for(; i < 0; ++i)
+			PUT('0');
+		PUT(*s);
+		s += 2;
+		}
+	else if (f__scale > 1) {
+		PUT(*s);
+		s += 2;
+		while(--i > 0)
+			PUT(*s++);
+		PUT('.');
+		}
+	if (d1) {
+		se -= 2;
+		while(s < se) PUT(*s++);
+		se += 2;
+		do PUT('0'); while(--d1 > 0);
+		}
+	while(s < se)
+		PUT(*s++);
+	if (e < 2)
+		PUT(s[1]);
+	else {
+		while(++e1 <= e)
+			PUT('0');
+		while(*s)
+			PUT(*s++);
+		}
+	return 0;
+	}
+
+#ifdef KR_headers
+wrt_F(p,w,d,len) ufloat *p; ftnlen len;
+#else
+wrt_F(ufloat *p, int w, int d, ftnlen len)
+#endif
+{
+	int d1, sign, n;
+	double x;
+	char *b, buf[MAXINTDIGS+MAXFRACDIGS+4], *s;
+
+	x= (len==sizeof(real)?p->pf:p->pd);
+	if (d < MAXFRACDIGS)
+		d1 = 0;
+	else {
+		d1 = d - MAXFRACDIGS;
+		d = MAXFRACDIGS;
+		}
+	if (x < 0.)
+		{ x = -x; sign = 1; }
+	else {
+		sign = 0;
+#ifndef VAX
+		if (!x)
+			x = 0.;
+#endif
+		}
+
+	if (n = f__scale)
+		if (n > 0)
+			do x *= 10.; while(--n > 0);
+		else
+			do x *= 0.1; while(++n < 0);
+
+#ifdef USE_STRLEN
+	sprintf(b = buf, "%#.*f", d, x);
+	n = strlen(b) + d1;
+#else
+	n = sprintf(b = buf, "%#.*f", d, x) + d1;
+#endif
+
+#ifndef WANT_LEAD_0
+	if (buf[0] == '0' && d)
+		{ ++b; --n; }
+#endif
+	if (sign) {
+		/* check for all zeros */
+		for(s = b;;) {
+			while(*s == '0') s++;
+			switch(*s) {
+				case '.':
+					s++; continue;
+				case 0:
+					sign = 0;
+				}
+			break;
+			}
+		}
+	if (sign || f__cplus)
+		++n;
+	if (n > w) {
+#ifdef WANT_LEAD_0
+		if (buf[0] == '0' && --n == w)
+			++b;
+		else
+#endif
+		{
+			while(--w >= 0)
+				PUT('*');
+			return 0;
+			}
+		}
+	for(w -= n; --w >= 0; )
+		PUT(' ');
+	if (sign)
+		PUT('-');
+	else if (f__cplus)
+		PUT('+');
+	while(n = *b++)
+		PUT(n);
+	while(--d1 >= 0)
+		PUT('0');
+	return 0;
+	}
diff --git a/gcc/f/runtime/libI77/wrtfmt.c b/gcc/f/runtime/libI77/wrtfmt.c
new file mode 100644
index 00000000000..e14efa85833
--- /dev/null
+++ b/gcc/f/runtime/libI77/wrtfmt.c
@@ -0,0 +1,385 @@
+#include "f2c.h"
+#include "fio.h"
+#include "fmt.h"
+
+extern icilist *f__svic;
+extern char *f__icptr;
+
+ static int
+mv_cur(Void)	/* shouldn't use fseek because it insists on calling fflush */
+		/* instead we know too much about stdio */
+{
+	int cursor = f__cursor;
+	f__cursor = 0;
+	if(f__external == 0) {
+		if(cursor < 0) {
+			if(f__hiwater < f__recpos)
+				f__hiwater = f__recpos;
+			f__recpos += cursor;
+			f__icptr += cursor;
+			if(f__recpos < 0)
+				err(f__elist->cierr, 110, "left off");
+		}
+		else if(cursor > 0) {
+			if(f__recpos + cursor >= f__svic->icirlen)
+				err(f__elist->cierr, 110, "recend");
+			if(f__hiwater <= f__recpos)
+				for(; cursor > 0; cursor--)
+					(*f__putn)(' ');
+			else if(f__hiwater <= f__recpos + cursor) {
+				cursor -= f__hiwater - f__recpos;
+				f__icptr += f__hiwater - f__recpos;
+				f__recpos = f__hiwater;
+				for(; cursor > 0; cursor--)
+					(*f__putn)(' ');
+			}
+			else {
+				f__icptr += cursor;
+				f__recpos += cursor;
+			}
+		}
+		return(0);
+	}
+	if(cursor > 0) {
+		if(f__hiwater <= f__recpos)
+			for(;cursor>0;cursor--) (*f__putn)(' ');
+		else if(f__hiwater <= f__recpos + cursor) {
+#if ! defined (NON_UNIX_STDIO) && ! defined (MISSING_FILE_ELEMS)
+			if(f__cf->_ptr + f__hiwater - f__recpos < buf_end(f__cf))
+				f__cf->_ptr += f__hiwater - f__recpos;
+			else
+#endif
+				(void) fseek(f__cf, (long) (f__hiwater - f__recpos), SEEK_CUR);
+			cursor -= f__hiwater - f__recpos;
+			f__recpos = f__hiwater;
+			for(; cursor > 0; cursor--)
+				(*f__putn)(' ');
+		}
+		else {
+#if ! defined (NON_UNIX_STDIO) && ! defined (MISSING_FILE_ELEMS)
+			if(f__cf->_ptr + cursor < buf_end(f__cf))
+				f__cf->_ptr += cursor;
+			else
+#endif
+				(void) fseek(f__cf, (long)cursor, SEEK_CUR);
+			f__recpos += cursor;
+		}
+	}
+	if(cursor<0)
+	{
+		if(cursor+f__recpos<0) err(f__elist->cierr,110,"left off");
+#if ! defined (NON_UNIX_STDIO) && ! defined (MISSING_FILE_ELEMS)
+		if(f__cf->_ptr + cursor >= f__cf->_base)
+			f__cf->_ptr += cursor;
+		else
+#endif
+		if(f__curunit && f__curunit->useek)
+			(void) fseek(f__cf,(long)cursor,SEEK_CUR);
+		else
+			err(f__elist->cierr,106,"fmt");
+		if(f__hiwater < f__recpos)
+			f__hiwater = f__recpos;
+		f__recpos += cursor;
+	}
+	return(0);
+}
+
+ static int
+#ifdef KR_headers
+wrt_Z(n,w,minlen,len) Uint *n; int w, minlen; ftnlen len;
+#else
+wrt_Z(Uint *n, int w, int minlen, ftnlen len)
+#endif
+{
+	register char *s, *se;
+	register int i, w1;
+	static int one = 1;
+	static char hex[] = "0123456789ABCDEF";
+	s = (char *)n;
+	--len;
+	if (*(char *)&one) {
+		/* little endian */
+		se = s;
+		s += len;
+		i = -1;
+		}
+	else {
+		se = s + len;
+		i = 1;
+		}
+	for(;; s += i)
+		if (s == se || *s)
+			break;
+	w1 = (i*(se-s) << 1) + 1;
+	if (*s & 0xf0)
+		w1++;
+	if (w1 > w)
+		for(i = 0; i < w; i++)
+			(*f__putn)('*');
+	else {
+		if ((minlen -= w1) > 0)
+			w1 += minlen;
+		while(--w >= w1)
+			(*f__putn)(' ');
+		while(--minlen >= 0)
+			(*f__putn)('0');
+		if (!(*s & 0xf0)) {
+			(*f__putn)(hex[*s & 0xf]);
+			if (s == se)
+				return 0;
+			s += i;
+			}
+		for(;; s += i) {
+			(*f__putn)(hex[*s >> 4 & 0xf]);
+			(*f__putn)(hex[*s & 0xf]);
+			if (s == se)
+				break;
+			}
+		}
+	return 0;
+	}
+
+ static int
+#ifdef KR_headers
+wrt_I(n,w,len, base) Uint *n; ftnlen len; register int base;
+#else
+wrt_I(Uint *n, int w, ftnlen len, register int base)
+#endif
+{	int ndigit,sign,spare,i;
+	longint x;
+	char *ans;
+	if(len==sizeof(integer)) x=n->il;
+	else if(len == sizeof(char)) x = n->ic;
+#ifdef Allow_TYQUAD
+	else if (len == sizeof(longint)) x = n->ili;
+#endif
+	else x=n->is;
+	ans=f__icvt(x,&ndigit,&sign, base);
+	spare=w-ndigit;
+	if(sign || f__cplus) spare--;
+	if(spare<0)
+		for(i=0;i<w;i++) (*f__putn)('*');
+	else
+	{	for(i=0;i<spare;i++) (*f__putn)(' ');
+		if(sign) (*f__putn)('-');
+		else if(f__cplus) (*f__putn)('+');
+		for(i=0;i<ndigit;i++) (*f__putn)(*ans++);
+	}
+	return(0);
+}
+ static int
+#ifdef KR_headers
+wrt_IM(n,w,m,len,base) Uint *n; ftnlen len; int base;
+#else
+wrt_IM(Uint *n, int w, int m, ftnlen len, int base)
+#endif
+{	int ndigit,sign,spare,i,xsign;
+	longint x;
+	char *ans;
+	if(sizeof(integer)==len) x=n->il;
+	else if(len == sizeof(char)) x = n->ic;
+#ifdef Allow_TYQUAD
+	else if (len == sizeof(longint)) x = n->ili;
+#endif
+	else x=n->is;
+	ans=f__icvt(x,&ndigit,&sign, base);
+	if(sign || f__cplus) xsign=1;
+	else xsign=0;
+	if(ndigit+xsign>w || m+xsign>w)
+	{	for(i=0;i<w;i++) (*f__putn)('*');
+		return(0);
+	}
+	if(x==0 && m==0)
+	{	for(i=0;i<w;i++) (*f__putn)(' ');
+		return(0);
+	}
+	if(ndigit>=m)
+		spare=w-ndigit-xsign;
+	else
+		spare=w-m-xsign;
+	for(i=0;i<spare;i++) (*f__putn)(' ');
+	if(sign) (*f__putn)('-');
+	else if(f__cplus) (*f__putn)('+');
+	for(i=0;i<m-ndigit;i++) (*f__putn)('0');
+	for(i=0;i<ndigit;i++) (*f__putn)(*ans++);
+	return(0);
+}
+ static int
+#ifdef KR_headers
+wrt_AP(s) char *s;
+#else
+wrt_AP(char *s)
+#endif
+{	char quote;
+	int i;
+
+	if(f__cursor && (i = mv_cur()))
+		return i;
+	quote = *s++;
+	for(;*s;s++)
+	{	if(*s!=quote) (*f__putn)(*s);
+		else if(*++s==quote) (*f__putn)(*s);
+		else return(1);
+	}
+	return(1);
+}
+ static int
+#ifdef KR_headers
+wrt_H(a,s) char *s;
+#else
+wrt_H(int a, char *s)
+#endif
+{
+	int i;
+
+	if(f__cursor && (i = mv_cur()))
+		return i;
+	while(a--) (*f__putn)(*s++);
+	return(1);
+}
+#ifdef KR_headers
+wrt_L(n,len, sz) Uint *n; ftnlen sz;
+#else
+wrt_L(Uint *n, int len, ftnlen sz)
+#endif
+{	int i;
+	long x;
+	if(sizeof(long)==sz) x=n->il;
+	else if(sz == sizeof(char)) x = n->ic;
+	else x=n->is;
+	for(i=0;i<len-1;i++)
+		(*f__putn)(' ');
+	if(x) (*f__putn)('T');
+	else (*f__putn)('F');
+	return(0);
+}
+ static int
+#ifdef KR_headers
+wrt_A(p,len) char *p; ftnlen len;
+#else
+wrt_A(char *p, ftnlen len)
+#endif
+{
+	while(len-- > 0) (*f__putn)(*p++);
+	return(0);
+}
+ static int
+#ifdef KR_headers
+wrt_AW(p,w,len) char * p; ftnlen len;
+#else
+wrt_AW(char * p, int w, ftnlen len)
+#endif
+{
+	while(w>len)
+	{	w--;
+		(*f__putn)(' ');
+	}
+	while(w-- > 0)
+		(*f__putn)(*p++);
+	return(0);
+}
+
+ static int
+#ifdef KR_headers
+wrt_G(p,w,d,e,len) ufloat *p; ftnlen len;
+#else
+wrt_G(ufloat *p, int w, int d, int e, ftnlen len)
+#endif
+{	double up = 1,x;
+	int i=0,oldscale,n,j;
+	x = len==sizeof(real)?p->pf:p->pd;
+	if(x < 0 ) x = -x;
+	if(x<.1) {
+		if (x != 0.)
+			return(wrt_E(p,w,d,e,len));
+		i = 1;
+		goto have_i;
+		}
+	for(;i<=d;i++,up*=10)
+	{	if(x>=up) continue;
+ have_i:
+		oldscale = f__scale;
+		f__scale = 0;
+		if(e==0) n=4;
+		else	n=e+2;
+		i=wrt_F(p,w-n,d-i,len);
+		for(j=0;j<n;j++) (*f__putn)(' ');
+		f__scale=oldscale;
+		return(i);
+	}
+	return(wrt_E(p,w,d,e,len));
+}
+#ifdef KR_headers
+w_ed(p,ptr,len) struct syl *p; char *ptr; ftnlen len;
+#else
+w_ed(struct syl *p, char *ptr, ftnlen len)
+#endif
+{
+	int i;
+
+	if(f__cursor && (i = mv_cur()))
+		return i;
+	switch(p->op)
+	{
+	default:
+		fprintf(stderr,"w_ed, unexpected code: %d\n", p->op);
+		sig_die(f__fmtbuf, 1);
+	case I:	return(wrt_I((Uint *)ptr,p->p1,len, 10));
+	case IM:
+		return(wrt_IM((Uint *)ptr,p->p1,p->p2,len,10));
+
+		/* O and OM don't work right for character, double, complex, */
+		/* or doublecomplex, and they differ from Fortran 90 in */
+		/* showing a minus sign for negative values. */
+
+	case O:	return(wrt_I((Uint *)ptr, p->p1, len, 8));
+	case OM:
+		return(wrt_IM((Uint *)ptr,p->p1,p->p2,len,8));
+	case L:	return(wrt_L((Uint *)ptr,p->p1, len));
+	case A: return(wrt_A(ptr,len));
+	case AW:
+		return(wrt_AW(ptr,p->p1,len));
+	case D:
+	case E:
+	case EE:
+		return(wrt_E((ufloat *)ptr,p->p1,p->p2,p->p3,len));
+	case G:
+	case GE:
+		return(wrt_G((ufloat *)ptr,p->p1,p->p2,p->p3,len));
+	case F:	return(wrt_F((ufloat *)ptr,p->p1,p->p2,len));
+
+		/* Z and ZM assume 8-bit bytes. */
+
+	case Z: return(wrt_Z((Uint *)ptr,p->p1,0,len));
+	case ZM:
+		return(wrt_Z((Uint *)ptr,p->p1,p->p2,len));
+	}
+}
+#ifdef KR_headers
+w_ned(p) struct syl *p;
+#else
+w_ned(struct syl *p)
+#endif
+{
+	switch(p->op)
+	{
+	default: fprintf(stderr,"w_ned, unexpected code: %d\n", p->op);
+		sig_die(f__fmtbuf, 1);
+	case SLASH:
+		return((*f__donewrec)());
+	case T: f__cursor = p->p1-f__recpos - 1;
+		return(1);
+	case TL: f__cursor -= p->p1;
+		if(f__cursor < -f__recpos)	/* TL1000, 1X */
+			f__cursor = -f__recpos;
+		return(1);
+	case TR:
+	case X:
+		f__cursor += p->p1;
+		return(1);
+	case APOS:
+		return(wrt_AP(*(char **)&p->p2));
+	case H:
+		return(wrt_H(p->p1,*(char **)&p->p2));
+	}
+}
diff --git a/gcc/f/runtime/libI77/wsfe.c b/gcc/f/runtime/libI77/wsfe.c
new file mode 100644
index 00000000000..5adb1a49f08
--- /dev/null
+++ b/gcc/f/runtime/libI77/wsfe.c
@@ -0,0 +1,85 @@
+/*write sequential formatted external*/
+#include "f2c.h"
+#include "fio.h"
+#include "fmt.h"
+extern int f__hiwater;
+
+#ifdef KR_headers
+x_putc(c)
+#else
+x_putc(int c)
+#endif
+{
+	/* this uses \n as an indicator of record-end */
+	if(c == '\n' && f__recpos < f__hiwater) {	/* fseek calls fflush, a loss */
+#if ! defined (NON_UNIX_STDIO) && ! defined (MISSING_FILE_ELEMS)
+		if(f__cf->_ptr + f__hiwater - f__recpos < buf_end(f__cf))
+			f__cf->_ptr += f__hiwater - f__recpos;
+		else
+#endif
+			(void) fseek(f__cf, (long)(f__hiwater - f__recpos), SEEK_CUR);
+	}
+#ifdef OMIT_BLANK_CC
+	if (!f__recpos++ && c == ' ')
+		return c;
+#else
+	f__recpos++;
+#endif
+	return putc(c,f__cf);
+}
+x_wSL(Void)
+{
+	(*f__putn)('\n');
+	f__recpos=0;
+	f__cursor = 0;
+	f__hiwater = 0;
+	return(1);
+}
+xw_end(Void)
+{
+	if(f__nonl == 0)
+		(*f__putn)('\n');
+	f__hiwater = f__recpos = f__cursor = 0;
+	return(0);
+}
+xw_rev(Void)
+{
+	if(f__workdone) (*f__putn)('\n');
+	f__hiwater = f__recpos = f__cursor = 0;
+	return(f__workdone=0);
+}
+
+#ifdef KR_headers
+integer s_wsfe(a) cilist *a;	/*start*/
+#else
+integer s_wsfe(cilist *a)	/*start*/
+#endif
+{	int n;
+	if(f__init != 1) f_init();
+	f__init = 3;
+	if(n=c_sfe(a)) return(n);
+	f__reading=0;
+	f__sequential=1;
+	f__formatted=1;
+	f__external=1;
+	f__elist=a;
+	f__hiwater = f__cursor=f__recpos=0;
+	f__nonl = 0;
+	f__scale=0;
+	f__fmtbuf=a->cifmt;
+	f__curunit = &f__units[a->ciunit];
+	f__cf=f__curunit->ufd;
+	if(pars_f(f__fmtbuf)<0) err(a->cierr,100,"startio");
+	f__putn= x_putc;
+	f__doed= w_ed;
+	f__doned= w_ned;
+	f__doend=xw_end;
+	f__dorevert=xw_rev;
+	f__donewrec=x_wSL;
+	fmt_bg();
+	f__cplus=0;
+	f__cblank=f__curunit->ublnk;
+	if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit))
+		err(a->cierr,errno,"write start");
+	return(0);
+}
diff --git a/gcc/f/runtime/libI77/wsle.c b/gcc/f/runtime/libI77/wsle.c
new file mode 100644
index 00000000000..d13f78f650b
--- /dev/null
+++ b/gcc/f/runtime/libI77/wsle.c
@@ -0,0 +1,41 @@
+#include "f2c.h"
+#include "fio.h"
+#include "fmt.h"
+#include "lio.h"
+
+#ifdef KR_headers
+integer s_wsle(a) cilist *a;
+#else
+integer s_wsle(cilist *a)
+#endif
+{
+	int n;
+	if(n=c_le(a)) return(n);
+	f__reading=0;
+	f__external=1;
+	f__formatted=1;
+	f__putn = t_putc;
+	f__lioproc = l_write;
+	L_len = LINE;
+	f__donewrec = x_wSL;
+	if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit))
+		err(a->cierr, errno, "list output start");
+	return(0);
+	}
+
+integer e_wsle(Void)
+{
+	f__init = 1;
+	t_putc('\n');
+	f__recpos=0;
+#ifdef ALWAYS_FLUSH
+	if (fflush(f__cf))
+		err(f__elist->cierr, errno, "write end");
+#else
+	if (f__cf == stdout)
+		fflush(stdout);
+	else if (f__cf == stderr)
+		fflush(stderr);
+#endif
+	return(0);
+	}
diff --git a/gcc/f/runtime/libI77/wsne.c b/gcc/f/runtime/libI77/wsne.c
new file mode 100644
index 00000000000..0febd52634f
--- /dev/null
+++ b/gcc/f/runtime/libI77/wsne.c
@@ -0,0 +1,26 @@
+#include "f2c.h"
+#include "fio.h"
+#include "lio.h"
+
+ integer
+#ifdef KR_headers
+s_wsne(a) cilist *a;
+#else
+s_wsne(cilist *a)
+#endif
+{
+	int n;
+
+	if(n=c_le(a))
+		return(n);
+	f__reading=0;
+	f__external=1;
+	f__formatted=1;
+	f__putn = t_putc;
+	L_len = LINE;
+	f__donewrec = x_wSL;
+	if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit))
+		err(a->cierr, errno, "namelist output start");
+	x_wsne(a);
+	return e_wsle();
+	}
diff --git a/gcc/f/runtime/libI77/xwsne.c b/gcc/f/runtime/libI77/xwsne.c
new file mode 100644
index 00000000000..71f6f1d5da5
--- /dev/null
+++ b/gcc/f/runtime/libI77/xwsne.c
@@ -0,0 +1,72 @@
+#include "f2c.h"
+#include "fio.h"
+#include "lio.h"
+#include "fmt.h"
+
+extern int f__Aquote;
+
+ static VOID
+nl_donewrec(Void)
+{
+	(*f__donewrec)();
+	PUT(' ');
+	}
+
+#ifdef KR_headers
+x_wsne(a) cilist *a;
+#else
+#include <string.h>
+
+ VOID
+x_wsne(cilist *a)
+#endif
+{
+	Namelist *nl;
+	char *s;
+	Vardesc *v, **vd, **vde;
+	ftnint *number, type;
+	ftnlen *dims;
+	ftnlen size;
+	static ftnint one = 1;
+	extern ftnlen f__typesize[];
+
+	nl = (Namelist *)a->cifmt;
+	PUT('&');
+	for(s = nl->name; *s; s++)
+		PUT(*s);
+	PUT(' ');
+	f__Aquote = 1;
+	vd = nl->vars;
+	vde = vd + nl->nvars;
+	while(vd < vde) {
+		v = *vd++;
+		s = v->name;
+#ifdef No_Extra_Namelist_Newlines
+		if (f__recpos+strlen(s)+2 >= L_len)
+#endif
+			nl_donewrec();
+		while(*s)
+			PUT(*s++);
+		PUT(' ');
+		PUT('=');
+		number = (dims = v->dims) ? dims + 1 : &one;
+		type = v->type;
+		if (type < 0) {
+			size = -type;
+			type = TYCHAR;
+			}
+		else
+			size = f__typesize[type];
+		l_write(number, v->addr, size, type);
+		if (vd < vde) {
+			if (f__recpos+2 >= L_len)
+				nl_donewrec();
+			PUT(',');
+			PUT(' ');
+			}
+		else if (f__recpos+1 >= L_len)
+			nl_donewrec();
+		}
+	f__Aquote = 0;
+	PUT('/');
+	}
diff --git a/gcc/f/runtime/libU77/COPYING.LIB b/gcc/f/runtime/libU77/COPYING.LIB
new file mode 100644
index 00000000000..eb685a5ec98
--- /dev/null
+++ b/gcc/f/runtime/libU77/COPYING.LIB
@@ -0,0 +1,481 @@
+		  GNU LIBRARY GENERAL PUBLIC LICENSE
+		       Version 2, June 1991
+
+ Copyright (C) 1991 Free Software Foundation, Inc.
+                    675 Mass Ave, Cambridge, MA 02139, USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+[This is the first released version of the library GPL.  It is
+ numbered 2 because it goes with version 2 of the ordinary GPL.]
+
+			    Preamble
+
+  The licenses for most software are designed to take away your
+freedom to share and change it.  By contrast, the GNU General Public
+Licenses are intended to guarantee your freedom to share and change
+free software--to make sure the software is free for all its users.
+
+  This license, the Library General Public License, applies to some
+specially designated Free Software Foundation software, and to any
+other libraries whose authors decide to use it.  You can use it for
+your libraries, too.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+  To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if
+you distribute copies of the library, or if you modify it.
+
+  For example, if you distribute copies of the library, whether gratis
+or for a fee, you must give the recipients all the rights that we gave
+you.  You must make sure that they, too, receive or can get the source
+code.  If you link a program with the library, you must provide
+complete object files to the recipients so that they can relink them
+with the library, after making changes to the library and recompiling
+it.  And you must show them these terms so they know their rights.
+
+  Our method of protecting your rights has two steps: (1) copyright
+the library, and (2) offer you this license which gives you legal
+permission to copy, distribute and/or modify the library.
+
+  Also, for each distributor's protection, we want to make certain
+that everyone understands that there is no warranty for this free
+library.  If the library is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original
+version, so that any problems introduced by others will not reflect on
+the original authors' reputations.
+
+  Finally, any free program is threatened constantly by software
+patents.  We wish to avoid the danger that companies distributing free
+software will individually obtain patent licenses, thus in effect
+transforming the program into proprietary software.  To prevent this,
+we have made it clear that any patent must be licensed for everyone's
+free use or not licensed at all.
+
+  Most GNU software, including some libraries, is covered by the ordinary
+GNU General Public License, which was designed for utility programs.  This
+license, the GNU Library General Public License, applies to certain
+designated libraries.  This license is quite different from the ordinary
+one; be sure to read it in full, and don't assume that anything in it is
+the same as in the ordinary license.
+
+  The reason we have a separate public license for some libraries is that
+they blur the distinction we usually make between modifying or adding to a
+program and simply using it.  Linking a program with a library, without
+changing the library, is in some sense simply using the library, and is
+analogous to running a utility program or application program.  However, in
+a textual and legal sense, the linked executable is a combined work, a
+derivative of the original library, and the ordinary General Public License
+treats it as such.
+
+  Because of this blurred distinction, using the ordinary General
+Public License for libraries did not effectively promote software
+sharing, because most developers did not use the libraries.  We
+concluded that weaker conditions might promote sharing better.
+
+  However, unrestricted linking of non-free programs would deprive the
+users of those programs of all benefit from the free status of the
+libraries themselves.  This Library General Public License is intended to
+permit developers of non-free programs to use free libraries, while
+preserving your freedom as a user of such programs to change the free
+libraries that are incorporated in them.  (We have not seen how to achieve
+this as regards changes in header files, but we have achieved it as regards
+changes in the actual functions of the Library.)  The hope is that this
+will lead to faster development of free libraries.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.  Pay close attention to the difference between a
+"work based on the library" and a "work that uses the library".  The
+former contains code derived from the library, while the latter only
+works together with the library.
+
+  Note that it is possible for a library to be covered by the ordinary
+General Public License rather than by this special one.
+
+		  GNU LIBRARY GENERAL PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. This License Agreement applies to any software library which
+contains a notice placed by the copyright holder or other authorized
+party saying it may be distributed under the terms of this Library
+General Public License (also called "this License").  Each licensee is
+addressed as "you".
+
+  A "library" means a collection of software functions and/or data
+prepared so as to be conveniently linked with application programs
+(which use some of those functions and data) to form executables.
+
+  The "Library", below, refers to any such software library or work
+which has been distributed under these terms.  A "work based on the
+Library" means either the Library or any derivative work under
+copyright law: that is to say, a work containing the Library or a
+portion of it, either verbatim or with modifications and/or translated
+straightforwardly into another language.  (Hereinafter, translation is
+included without limitation in the term "modification".)
+
+  "Source code" for a work means the preferred form of the work for
+making modifications to it.  For a library, complete source code means
+all the source code for all modules it contains, plus any associated
+interface definition files, plus the scripts used to control compilation
+and installation of the library.
+
+  Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope.  The act of
+running a program using the Library is not restricted, and output from
+such a program is covered only if its contents constitute a work based
+on the Library (independent of the use of the Library in a tool for
+writing it).  Whether that is true depends on what the Library does
+and what the program that uses the Library does.
+  
+  1. You may copy and distribute verbatim copies of the Library's
+complete source code as you receive it, in any medium, provided that
+you conspicuously and appropriately publish on each copy an
+appropriate copyright notice and disclaimer of warranty; keep intact
+all the notices that refer to this License and to the absence of any
+warranty; and distribute a copy of this License along with the
+Library.
+
+  You may charge a fee for the physical act of transferring a copy,
+and you may at your option offer warranty protection in exchange for a
+fee.
+
+  2. You may modify your copy or copies of the Library or any portion
+of it, thus forming a work based on the Library, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+    a) The modified work must itself be a software library.
+
+    b) You must cause the files modified to carry prominent notices
+    stating that you changed the files and the date of any change.
+
+    c) You must cause the whole of the work to be licensed at no
+    charge to all third parties under the terms of this License.
+
+    d) If a facility in the modified Library refers to a function or a
+    table of data to be supplied by an application program that uses
+    the facility, other than as an argument passed when the facility
+    is invoked, then you must make a good faith effort to ensure that,
+    in the event an application does not supply such function or
+    table, the facility still operates, and performs whatever part of
+    its purpose remains meaningful.
+
+    (For example, a function in a library to compute square roots has
+    a purpose that is entirely well-defined independent of the
+    application.  Therefore, Subsection 2d requires that any
+    application-supplied function or table used by this function must
+    be optional: if the application does not supply it, the square
+    root function must still compute square roots.)
+
+These requirements apply to the modified work as a whole.  If
+identifiable sections of that work are not derived from the Library,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works.  But when you
+distribute the same sections as part of a whole which is a work based
+on the Library, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote
+it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Library.
+
+In addition, mere aggregation of another work not based on the Library
+with the Library (or with a work based on the Library) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+  3. You may opt to apply the terms of the ordinary GNU General Public
+License instead of this License to a given copy of the Library.  To do
+this, you must alter all the notices that refer to this License, so
+that they refer to the ordinary GNU General Public License, version 2,
+instead of to this License.  (If a newer version than version 2 of the
+ordinary GNU General Public License has appeared, then you can specify
+that version instead if you wish.)  Do not make any other change in
+these notices.
+
+  Once this change is made in a given copy, it is irreversible for
+that copy, so the ordinary GNU General Public License applies to all
+subsequent copies and derivative works made from that copy.
+
+  This option is useful when you wish to copy part of the code of
+the Library into a program that is not a library.
+
+  4. You may copy and distribute the Library (or a portion or
+derivative of it, under Section 2) in object code or executable form
+under the terms of Sections 1 and 2 above provided that you accompany
+it with the complete corresponding machine-readable source code, which
+must be distributed under the terms of Sections 1 and 2 above on a
+medium customarily used for software interchange.
+
+  If distribution of object code is made by offering access to copy
+from a designated place, then offering equivalent access to copy the
+source code from the same place satisfies the requirement to
+distribute the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+  5. A program that contains no derivative of any portion of the
+Library, but is designed to work with the Library by being compiled or
+linked with it, is called a "work that uses the Library".  Such a
+work, in isolation, is not a derivative work of the Library, and
+therefore falls outside the scope of this License.
+
+  However, linking a "work that uses the Library" with the Library
+creates an executable that is a derivative of the Library (because it
+contains portions of the Library), rather than a "work that uses the
+library".  The executable is therefore covered by this License.
+Section 6 states terms for distribution of such executables.
+
+  When a "work that uses the Library" uses material from a header file
+that is part of the Library, the object code for the work may be a
+derivative work of the Library even though the source code is not.
+Whether this is true is especially significant if the work can be
+linked without the Library, or if the work is itself a library.  The
+threshold for this to be true is not precisely defined by law.
+
+  If such an object file uses only numerical parameters, data
+structure layouts and accessors, and small macros and small inline
+functions (ten lines or less in length), then the use of the object
+file is unrestricted, regardless of whether it is legally a derivative
+work.  (Executables containing this object code plus portions of the
+Library will still fall under Section 6.)
+
+  Otherwise, if the work is a derivative of the Library, you may
+distribute the object code for the work under the terms of Section 6.
+Any executables containing that work also fall under Section 6,
+whether or not they are linked directly with the Library itself.
+
+  6. As an exception to the Sections above, you may also compile or
+link a "work that uses the Library" with the Library to produce a
+work containing portions of the Library, and distribute that work
+under terms of your choice, provided that the terms permit
+modification of the work for the customer's own use and reverse
+engineering for debugging such modifications.
+
+  You must give prominent notice with each copy of the work that the
+Library is used in it and that the Library and its use are covered by
+this License.  You must supply a copy of this License.  If the work
+during execution displays copyright notices, you must include the
+copyright notice for the Library among them, as well as a reference
+directing the user to the copy of this License.  Also, you must do one
+of these things:
+
+    a) Accompany the work with the complete corresponding
+    machine-readable source code for the Library including whatever
+    changes were used in the work (which must be distributed under
+    Sections 1 and 2 above); and, if the work is an executable linked
+    with the Library, with the complete machine-readable "work that
+    uses the Library", as object code and/or source code, so that the
+    user can modify the Library and then relink to produce a modified
+    executable containing the modified Library.  (It is understood
+    that the user who changes the contents of definitions files in the
+    Library will not necessarily be able to recompile the application
+    to use the modified definitions.)
+
+    b) Accompany the work with a written offer, valid for at
+    least three years, to give the same user the materials
+    specified in Subsection 6a, above, for a charge no more
+    than the cost of performing this distribution.
+
+    c) If distribution of the work is made by offering access to copy
+    from a designated place, offer equivalent access to copy the above
+    specified materials from the same place.
+
+    d) Verify that the user has already received a copy of these
+    materials or that you have already sent this user a copy.
+
+  For an executable, the required form of the "work that uses the
+Library" must include any data and utility programs needed for
+reproducing the executable from it.  However, as a special exception,
+the source code distributed need not include anything that is normally
+distributed (in either source or binary form) with the major
+components (compiler, kernel, and so on) of the operating system on
+which the executable runs, unless that component itself accompanies
+the executable.
+
+  It may happen that this requirement contradicts the license
+restrictions of other proprietary libraries that do not normally
+accompany the operating system.  Such a contradiction means you cannot
+use both them and the Library together in an executable that you
+distribute.
+
+  7. You may place library facilities that are a work based on the
+Library side-by-side in a single library together with other library
+facilities not covered by this License, and distribute such a combined
+library, provided that the separate distribution of the work based on
+the Library and of the other library facilities is otherwise
+permitted, and provided that you do these two things:
+
+    a) Accompany the combined library with a copy of the same work
+    based on the Library, uncombined with any other library
+    facilities.  This must be distributed under the terms of the
+    Sections above.
+
+    b) Give prominent notice with the combined library of the fact
+    that part of it is a work based on the Library, and explaining
+    where to find the accompanying uncombined form of the same work.
+
+  8. You may not copy, modify, sublicense, link with, or distribute
+the Library except as expressly provided under this License.  Any
+attempt otherwise to copy, modify, sublicense, link with, or
+distribute the Library is void, and will automatically terminate your
+rights under this License.  However, parties who have received copies,
+or rights, from you under this License will not have their licenses
+terminated so long as such parties remain in full compliance.
+
+  9. You are not required to accept this License, since you have not
+signed it.  However, nothing else grants you permission to modify or
+distribute the Library or its derivative works.  These actions are
+prohibited by law if you do not accept this License.  Therefore, by
+modifying or distributing the Library (or any work based on the
+Library), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Library or works based on it.
+
+  10. Each time you redistribute the Library (or any work based on the
+Library), the recipient automatically receives a license from the
+original licensor to copy, distribute, link with or modify the Library
+subject to these terms and conditions.  You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+  11. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Library at all.  For example, if a patent
+license would not permit royalty-free redistribution of the Library by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Library.
+
+If any portion of this section is held invalid or unenforceable under any
+particular circumstance, the balance of the section is intended to apply,
+and the section as a whole is intended to apply in other circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system which is
+implemented by public license practices.  Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+  12. If the distribution and/or use of the Library is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Library under this License may add
+an explicit geographical distribution limitation excluding those countries,
+so that distribution is permitted only in or among countries not thus
+excluded.  In such case, this License incorporates the limitation as if
+written in the body of this License.
+
+  13. The Free Software Foundation may publish revised and/or new
+versions of the Library General Public License from time to time.
+Such new versions will be similar in spirit to the present version,
+but may differ in detail to address new problems or concerns.
+
+Each version is given a distinguishing version number.  If the Library
+specifies a version number of this License which applies to it and
+"any later version", you have the option of following the terms and
+conditions either of that version or of any later version published by
+the Free Software Foundation.  If the Library does not specify a
+license version number, you may choose any version ever published by
+the Free Software Foundation.
+
+  14. If you wish to incorporate parts of the Library into other free
+programs whose distribution conditions are incompatible with these,
+write to the author to ask for permission.  For software which is
+copyrighted by the Free Software Foundation, write to the Free
+Software Foundation; we sometimes make exceptions for this.  Our
+decision will be guided by the two goals of preserving the free status
+of all derivatives of our free software and of promoting the sharing
+and reuse of software generally.
+
+			    NO WARRANTY
+
+  15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
+WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
+EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
+OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
+KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
+LIBRARY IS WITH YOU.  SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
+THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+  16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
+WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
+AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
+FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
+CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
+LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
+FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGES.
+
+		     END OF TERMS AND CONDITIONS
+
+     Appendix: How to Apply These Terms to Your New Libraries
+
+  If you develop a new library, and you want it to be of the greatest
+possible use to the public, we recommend making it free software that
+everyone can redistribute and change.  You can do so by permitting
+redistribution under these terms (or, alternatively, under the terms of the
+ordinary General Public License).
+
+  To apply these terms, attach the following notices to the library.  It is
+safest to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least the
+"copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the library's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    This library 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
+    Library General Public License for more details.
+
+    You should have received a copy of the GNU Library General Public
+    License along with this library; if not, write to the Free
+    Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+Also add information on how to contact you by electronic and paper mail.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the library, if
+necessary.  Here is a sample; alter the names:
+
+  Yoyodyne, Inc., hereby disclaims all copyright interest in the
+  library `Frob' (a library for tweaking knobs) written by James Random Hacker.
+
+  <signature of Ty Coon>, 1 April 1990
+  Ty Coon, President of Vice
+
+That's all there is to it!
diff --git a/gcc/f/runtime/libU77/Makefile.in b/gcc/f/runtime/libU77/Makefile.in
new file mode 100644
index 00000000000..2e6846b23de
--- /dev/null
+++ b/gcc/f/runtime/libU77/Makefile.in
@@ -0,0 +1,155 @@
+# Makefile for GNU F77 compiler runtime, libc interface.
+# Copyright (C) 1995-1997 Free Software Foundation, Inc.
+#   Contributed by Dave Love (d.love@dl.ac.uk).
+#
+#This file is part of GNU Fortran libU77 library.
+#
+#This library is free software; you can redistribute it and/or modify
+#it under the terms of the GNU Library 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
+#Library 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
+#Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
+SHELL = /bin/sh
+
+srcdir = @srcdir@
+VPATH = @srcdir@
+
+#### Start of system configuration section. ####
+
+# The _FOR_TARGET things are appropriate for a cross-make, passed by the
+# superior makefile
+GCC_FOR_TARGET = @CC@
+CC = $(GCC_FOR_TARGET)
+CFLAGS = @CFLAGS@ $(GCC_FLAGS)
+CPPFLAGS = @CPPFLAGS@
+DEFS = @DEFS@
+CGFLAGS = -g0
+# f2c.h should already be installed in xgcc's include directory but add that
+# to -I anyhow in case not using xgcc.  fio.h is in libI77.  We need config.h
+# from `.'.
+ALL_CFLAGS = -I. -I$(srcdir) -I$(srcdir)/../libI77 -I../../../include $(CPPFLAGS) $(DEFS) $(CFLAGS)
+AR = @AR@
+AR_FLAGS = rc
+RANLIB = @RANLIB@
+RANLIB_TEST = @RANLIB_TEST@
+CROSS = @CROSS@
+G77DIR = ../../../
+
+.SUFFIXES:
+.SUFFIXES: .c .o
+
+.c.o:
+	$(CC) -c -DSkip_f2c_Undefs $(ALL_CFLAGS) $(CGFLAGS) $<
+
+OBJS =  VersionU.o gerror_.o perror_.o ierrno_.o itime_.o time_.o \
+	unlink_.o fnum_.o getpid_.o getuid_.o getgid_.o kill_.o rand_.o \
+	srand_.o irand_.o sleep_.o idate_.o ctime_.o etime_.o \
+	dtime_.o  isatty_.o ltime_.o fstat_.o stat_.o \
+	lstat_.o access_.o link_.o getlog_.o ttynam_.o getcwd_.o symlnk_.o \
+        vxttime_.o vxtidate_.o gmtime_.o fdate_.o secnds_.o \
+	bes.o dbes.o \
+	chdir_.o chmod_.o lnblnk_.o hostnm_.o rename_.o fgetc_.o fputc_.o \
+        umask_.o system_clock_.o date_.o second_.o flush1_.o mclock_.o \
+	alarm_.o
+SRCS =  Version.c gerror_.c perror_.c ierrno_.c itime_.c time_.c \
+	unlink_.c fnum_.c getpid_.c getuid_.c getgid_.c kill_.c rand_.c \
+	srand_.c irand_.c sleep_.c idate_.c ctime_.c etime_.c \
+	dtime_.c isatty_.c ltime_.c fstat_.c stat_.c \
+	lstat_.c access_.c link_.c getlog_.c ttynam_.c getcwd_.c symlnk_.c \
+        vxttime_.c vxtidate_.c gmtime_.c fdate_.c secnds_.c \
+	bes.c dbes.c \
+	chdir_.c chmod_.c lnblnk_.c hostnm_.c rename_.c fgetc_.c fputc_.c \
+	umask_.c system_clock_.c date_.c second_.c flush1_.c mclock_.c \
+	alarm_.c
+
+F2C_H = ../../../include/f2c.h
+
+all: $(OBJS)
+
+VersionU.o: Version.c
+	$(CC) -c $(CGFLAGS) -o $@ $(srcdir)/Version.c
+
+lint:
+	lint $(CFLAGS) $(SRCS)
+
+mostlyclean:
+	-rm -f $(OBJS)
+
+clean: mostlyclean
+	-rm -f config.log a.out
+
+distclean realclean maintainer-clean: clean
+	-rm -f config.h Makefile config.status config.cache stage? include
+
+$(OBJS): $(F2C_H) config.h
+
+check:
+	-$(G77DIR)g77 --driver=$(G77DIR)/xgcc -B$(G77DIR) -g $(srcdir)/u77-test.f $(lib) && ./a.out
+	rm -f a.out
+
+access_.o: access_.c
+ctime_.o: ctime_.c
+dtime_.o: dtime_.c
+etime_.o: etime_.c
+fnum_.o: fnum_.c $(srcdir)/../libI77/fio.h
+fstat_.o: fstat_.c
+gerror_.o: gerror_.c
+getcwd_.o: getcwd_.c
+getgid_.o: getgid_.c
+getlog_.o: getlog_.c
+getpid_.o: getpid_.c
+getuid_.o: getuid_.c
+idate_.o: idate_.c
+ierrno_.o: ierrno_.c
+irand_.o: irand_.c
+isatty_.o: isatty_.c $(srcdir)/../libI77/fio.h
+itime_.o: itime_.c
+kill_.o: kill_.c
+link_.o: link_.c
+loc_.o: loc_.c
+lstat_.o: lstat_.c
+ltime_.o: ltime_.c
+perror_.o: perror_.c
+qsort.o: qsort.c
+qsort_.o: qsort_.c
+rand_.o: rand_.c
+rename_.o: rename_.c
+second_.o: second_.c
+sleep_.o: sleep_.c
+srand_.o: srand_.c
+stat_.o: stat_.c
+symlnk_.o: symlnk_.c
+time_.o: time_.c
+ttynam_.o: ttynam_.c
+unlink_.o: unlink_.c
+wait_.o: wait_.c
+vxttime_.o: vxttime_.c
+vtxidate_.o: vxtidate_.c
+fdate_.o: fdate_.c
+gmtime_.o: gmtime_.c
+secnds_.o: secnds_.c
+bes.o: bes.c
+dbes.o: dbes.c
+lnblnk_.o: lnblnk_.c
+chmod_.o: chmod_.c
+chdir_.o: chdir_.c
+hostnm_.o: hostnm_.c
+rename_.o: rename_.c
+fputc_.o: fputc_.c
+fgetc_.o: fgetc_.c
+system_clock_.o: system_clock_.c
+umask_.o: umask_.c
+flush1_.o: flush1_.c
+mclock_.o: mclock_.c
+alarm_.o: alarm_.c
+
+.PHONY: mostlyclean clean distclean maintainer-clean lint check all
diff --git a/gcc/f/runtime/libU77/PROJECTS b/gcc/f/runtime/libU77/PROJECTS
new file mode 100644
index 00000000000..0cf1383cbf9
--- /dev/null
+++ b/gcc/f/runtime/libU77/PROJECTS
@@ -0,0 +1,10 @@
+                                                    -*- indented-text-*-
+
+* Interface to strget
+
+* Non-blocking (`asynchronous') i/o (per c.l.f. discussion)
+
+* `ioinit'-type routine for various i/o options
+
+* IEEE/VAX/... number format conversion (or XDR interface).  This
+  might be made optionally transparent per logical unit a la DECtran.
diff --git a/gcc/f/runtime/libU77/README b/gcc/f/runtime/libU77/README
new file mode 100644
index 00000000000..9033a495f1b
--- /dev/null
+++ b/gcc/f/runtime/libU77/README
@@ -0,0 +1,40 @@
+19970811						    -*-text-*-
+
+g77 libU77
+----------
+
+This directory contains an implementation of most of the `traditional'
+Unix libU77 routines, mostly an interface to libc and libm routines
+and some extra ones for time and date etc.  It's intended for use with
+g77, to whose configuration procedure it's currently tied, but should
+be compatible with f2c otherwise, if using the same f2c.h.
+
+The contents of libU77 and its interfaces aren't consistent across
+implementations.  This one is mostly taken from documentation for (an
+old version of) the Convex implementation and the v2 SunPro one.
+As of g77 version 0.5.20, most of these routines have been made
+into g77 intrinsics.  Some routines have a version with a name prefixed
+by `vxt', corresponding to the VMS Fortran versions, and these should
+be integrated with g77's intrinsics visibility control.
+
+A few routines are currently missing; in the case of `fork', for
+instance, because they're probably not useful, and in the case of
+`qsort' and those for stream-based i/o handling, because they need
+more effort/research.  The configuration should weed out those few
+which correspond to facilities which may not be present on some Unix
+systems, such as symbolic links.  It's unclear whether the interfaces
+to the native library random number routines should be retained, since
+their implementation is likely to be something one should avoid
+assiduously.
+
+This library has been tested it under SunOS4.1.3 and Irix5.2 and there
+has been some feedback from Linux; presumably potential problems lie
+mainly with systems with impoverished native C library support which
+haven't been properly taken care of with autoconf.
+
+There's another GPL'd implementation of this stuff which I only found
+out about recently (despite having looked) and I haven't yet checked
+how they should be amalgamated.
+
+Dave Love <d.love@dl.ac.uk>  Aug '95
+(minor changes by Craig Burley <burley@gnu.ai.mit.edu> Aug '97)
diff --git a/gcc/f/runtime/libU77/Version.c b/gcc/f/runtime/libU77/Version.c
new file mode 100644
index 00000000000..3251491815d
--- /dev/null
+++ b/gcc/f/runtime/libU77/Version.c
@@ -0,0 +1,12 @@
+static char junk[] = "\n@(#) LIBU77 VERSION 19970609\n";
+
+char __G77_LIBU77_VERSION__[] = "0.5.21-19970811";
+
+#include <stdio.h>
+
+void
+g77__uvers__ ()
+{
+  fprintf (stderr, "__G77_LIBU77_VERSION__: %s", __G77_LIBU77_VERSION__);
+  fputs (junk, stderr);
+}
diff --git a/gcc/f/runtime/libU77/access_.c b/gcc/f/runtime/libU77/access_.c
new file mode 100644
index 00000000000..1699ef065f2
--- /dev/null
+++ b/gcc/f/runtime/libU77/access_.c
@@ -0,0 +1,80 @@
+/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#if HAVE_UNISTD_H
+#  include <unistd.h>
+#endif
+#if HAVE_STDLIB_H
+#  include <stdlib.h>
+#else
+#  include <stdio.h>		/* for NULL */
+#endif
+
+#include <errno.h>
+#include <limits.h>
+#include "f2c.h"
+
+#ifndef R_OK			/* for SVR1-2 */
+#  define R_OK 4
+#endif
+#ifndef W_OK
+#  define W_OK 2
+#endif
+#ifndef X_OK
+#  define X_OK 1
+#endif
+#ifndef F_OK
+#  define F_OK 0
+#endif
+
+#ifdef KR_headers
+void g_char ();
+
+integer G77_access_0 (name, mode, Lname, Lmode)
+     char *name, *mode;
+     ftnlen Lname, Lmode;
+#else
+void g_char(const char *a, ftnlen alen, char *b);
+
+integer G77_access_0 (const char *name, const char *mode, ftnlen Lname, ftnlen Lmode)
+#endif
+{
+  char *buff;
+  char *bp, *blast;
+  int amode, i;
+
+  buff = malloc (Lname+1);
+  if (buff == NULL) return -1;
+  g_char (name, Lname, buff);
+  amode = 0;
+  for (i=0;i<Lmode;i++) {
+    switch (mode[i]) {
+    case 'r': amode |= R_OK; break;
+    case 'w': amode |= W_OK; break;
+    case 'x': amode |= X_OK; break;
+    case ' ': amode |= F_OK; break; /* as per Sun, at least */
+    default: return EINVAL;
+    }
+  }
+  i = access (buff, amode);
+  free (buff);
+  return i;
+}
diff --git a/gcc/f/runtime/libU77/acconfig.h b/gcc/f/runtime/libU77/acconfig.h
new file mode 100644
index 00000000000..12bba85b869
--- /dev/null
+++ b/gcc/f/runtime/libU77/acconfig.h
@@ -0,0 +1,2 @@
+/* Define as the path of the `chmod' program. */
+#undef CHMOD_PATH
diff --git a/gcc/f/runtime/libU77/alarm_.c b/gcc/f/runtime/libU77/alarm_.c
new file mode 100644
index 00000000000..cc869ff7898
--- /dev/null
+++ b/gcc/f/runtime/libU77/alarm_.c
@@ -0,0 +1,59 @@
+/* Copyright (C) 1997 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+
+#if HAVE_UNISTD_H
+#  include <unistd.h>
+#endif
+
+#include "f2c.h"
+
+#ifndef RETSIGTYPE
+/* we shouldn't rely on this... */
+#ifdef KR_headers
+#define RETSIGTYPE int
+#else
+#define RETSIGTYPE void
+#endif
+#endif
+typedef RETSIGTYPE (*sig_type)();
+
+#ifdef KR_headers
+extern sig_type signal();
+
+int G77_alarm_0 (seconds, proc)
+     integer *seconds;
+     sig_type proc;
+#else
+#include <signal.h>
+typedef int (*sig_proc)(int);
+
+int G77_alarm_0 (integer *seconds, sig_proc proc)
+#endif
+{
+  int status;
+
+  if (signal(SIGALRM, (sig_type)proc) == SIG_ERR)
+    status = -1;
+  else
+    status = alarm (*seconds);
+  return status;
+}
diff --git a/gcc/f/runtime/libU77/bes.c b/gcc/f/runtime/libU77/bes.c
new file mode 100644
index 00000000000..c5ffdce59a3
--- /dev/null
+++ b/gcc/f/runtime/libU77/bes.c
@@ -0,0 +1,46 @@
+/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#if 0 	/* Don't include these unless necessary -- jcb. */
+#include "f2c.h"
+#include <math.h>
+
+doublereal G77_besj0_0 (const real *x) {
+    return j0 (*x);
+}
+
+doublereal G77_besj1_0 (const real *x) {
+    return j1 (*x);
+}
+
+doublereal G77_besjn_0 (const integer *n, real *x) {
+     return jn (*n, *x);
+ }
+
+doublereal G77_besy0_0 (const real *x) {
+    return y0 (*x);
+}
+
+doublereal G77_besy1_0 (const real *x) {
+    return y1 (*x);
+}
+
+doublereal G77_besyn_0 (const integer *n, real *x) {
+    return yn (*n, *x);
+}
+#endif
diff --git a/gcc/f/runtime/libU77/chdir_.c b/gcc/f/runtime/libU77/chdir_.c
new file mode 100644
index 00000000000..500be54fbe6
--- /dev/null
+++ b/gcc/f/runtime/libU77/chdir_.c
@@ -0,0 +1,57 @@
+/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#if HAVE_UNISTD_H
+#  include <unistd.h>
+#endif
+#if HAVE_STDLIB_H
+#  include <stdlib.h>
+#else
+#  include <stdio.h>
+#endif
+
+#include <errno.h>
+#include "f2c.h"
+
+
+#ifdef KR_headers
+void g_char ();
+
+integer G77_chdir_0 (name, Lname)
+     char *name;
+     ftnlen Lname;
+#else
+void g_char(const char *a, ftnlen alen, char *b);
+
+integer G77_chdir_0 (const char *name, const ftnlen Lname)
+#endif
+{
+  char *buff;
+  char *bp, *blast;
+  int i;
+
+  buff = malloc (Lname+1);
+  if (buff == NULL) return -1;
+  g_char (name, Lname, buff);
+  i = chdir (buff);
+  free (buff);
+  return i ? errno : 0;
+}
diff --git a/gcc/f/runtime/libU77/chmod_.c b/gcc/f/runtime/libU77/chmod_.c
new file mode 100644
index 00000000000..9797b80f3f5
--- /dev/null
+++ b/gcc/f/runtime/libU77/chmod_.c
@@ -0,0 +1,79 @@
+/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+
+/* This definitely shouldn't be done this way -- should canibalise
+   chmod(1) from GNU or BSD. */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#if HAVE_UNISTD_H
+#  include <unistd.h>
+#endif
+#if HAVE_STDLIB_H
+#  include <stdlib.h>
+#else
+#  include <stdio.h>		/* for NULL */
+#endif
+
+#include "f2c.h"
+
+#ifndef CHMOD_PATH
+#define CHMOD_PATH "/bin/chmod"
+#endif
+
+#ifdef KR_headers
+extern void s_cat ();
+void g_char ();
+
+integer G77_chmod_0 (name, mode, Lname, Lmode)
+     char *name, *mode;
+     ftnlen Lname, Lmode;
+#else
+extern void s_cat(char *lp, char *rpp[], ftnlen rnp[], ftnlen *np, ftnlen ll);
+void g_char(const char *a, ftnlen alen, char *b);
+
+integer G77_chmod_0 (/* const */ char *name, /* const */ char *mode, const ftnlen Lname, const ftnlen Lmode)
+#endif
+{
+  char *buff;
+  char *bp, *blast;
+  int i;
+  ftnlen l, l2;
+  ftnlen six = 6;
+  address a[6];
+  ftnlen ii[6];
+  char chmod_path [] = CHMOD_PATH;
+  l = strlen (chmod_path);
+  buff = malloc (Lname+Lmode+l+3+13+1);
+  if (buff == NULL) return -1;
+  ii[0] = l; a[0] = chmod_path;
+  ii[1] = 1; a[1] = " ";
+  ii[2] = Lmode; a[2] = mode;
+  ii[3] = 2; a[3] = " '";
+  for (l2=Lname; (l2 > 1) && (name[l2-1] == ' '); )
+    l2--;
+  ii[4] = l2; a[4] = name;
+  ii[5] = 13; a[5] = "' 2>/dev/null";
+  s_cat (buff, a, ii, &six, Lname+Lmode+l+3+13);
+  buff[Lname+Lmode+l+3+13] = '\0';
+  i = system (buff);
+  free (buff);
+  return i;
+}
diff --git a/gcc/f/runtime/libU77/config.h.in b/gcc/f/runtime/libU77/config.h.in
new file mode 100644
index 00000000000..45ada20e236
--- /dev/null
+++ b/gcc/f/runtime/libU77/config.h.in
@@ -0,0 +1,73 @@
+/* config.h.in.  Generated automatically from configure.in by autoheader.  */
+
+/* Define to empty if the keyword does not work.  */
+#undef const
+
+/* Define if your struct stat has st_blksize.  */
+#undef HAVE_ST_BLKSIZE
+
+/* Define if your struct stat has st_blocks.  */
+#undef HAVE_ST_BLOCKS
+
+/* Define if your struct stat has st_rdev.  */
+#undef HAVE_ST_RDEV
+
+/* Define to `int' if <sys/types.h> doesn't define.  */
+#undef mode_t
+
+/* Define to `int' if <sys/types.h> doesn't define.  */
+#undef pid_t
+
+/* Define to `unsigned' if <sys/types.h> doesn't define.  */
+#undef size_t
+
+/* Define if you have the ANSI C header files.  */
+#undef STDC_HEADERS
+
+/* Define if you can safely include both <sys/time.h> and <time.h>.  */
+#undef TIME_WITH_SYS_TIME
+
+/* Define if your <sys/time.h> declares struct tm.  */
+#undef TM_IN_SYS_TIME
+
+/* Define as the path of the `chmod' program. */
+#undef CHMOD_PATH
+
+/* Define if you have the clock function.  */
+#undef HAVE_CLOCK
+
+/* Define if you have the getcwd function.  */
+#undef HAVE_GETCWD
+
+/* Define if you have the gethostname function.  */
+#undef HAVE_GETHOSTNAME
+
+/* Define if you have the getrusage function.  */
+#undef HAVE_GETRUSAGE
+
+/* Define if you have the getwd function.  */
+#undef HAVE_GETWD
+
+/* Define if you have the lstat function.  */
+#undef HAVE_LSTAT
+
+/* Define if you have the strerror function.  */
+#undef HAVE_STRERROR
+
+/* Define if you have the symlink function.  */
+#undef HAVE_SYMLINK
+
+/* Define if you have the <limits.h> header file.  */
+#undef HAVE_LIMITS_H
+
+/* Define if you have the <stdlib.h> header file.  */
+#undef HAVE_STDLIB_H
+
+/* Define if you have the <string.h> header file.  */
+#undef HAVE_STRING_H
+
+/* Define if you have the <sys/time.h> header file.  */
+#undef HAVE_SYS_TIME_H
+
+/* Define if you have the <unistd.h> header file.  */
+#undef HAVE_UNISTD_H
diff --git a/gcc/f/runtime/libU77/configure b/gcc/f/runtime/libU77/configure
new file mode 100755
index 00000000000..63fb0e7844e
--- /dev/null
+++ b/gcc/f/runtime/libU77/configure
@@ -0,0 +1,1758 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.12 
+# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+
+# Defaults:
+ac_help=
+ac_default_prefix=/usr/local
+# Any additions from configure.in:
+
+# Initialize some variables set by options.
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+build=NONE
+cache_file=./config.cache
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+# Initialize some other variables.
+subdirs=
+MFLAGS= MAKEFLAGS=
+# Maximum number of lines to put in a shell here document.
+ac_max_here_lines=12
+
+ac_prev=
+for ac_option
+do
+
+  # If the previous option needs an argument, assign it.
+  if test -n "$ac_prev"; then
+    eval "$ac_prev=\$ac_option"
+    ac_prev=
+    continue
+  fi
+
+  case "$ac_option" in
+  -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+  *) ac_optarg= ;;
+  esac
+
+  # Accept the important Cygnus configure options, so we can diagnose typos.
+
+  case "$ac_option" in
+
+  -bindir | --bindir | --bindi | --bind | --bin | --bi)
+    ac_prev=bindir ;;
+  -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+    bindir="$ac_optarg" ;;
+
+  -build | --build | --buil | --bui | --bu)
+    ac_prev=build ;;
+  -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+    build="$ac_optarg" ;;
+
+  -cache-file | --cache-file | --cache-fil | --cache-fi \
+  | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+    ac_prev=cache_file ;;
+  -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+  | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+    cache_file="$ac_optarg" ;;
+
+  -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+    ac_prev=datadir ;;
+  -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+  | --da=*)
+    datadir="$ac_optarg" ;;
+
+  -disable-* | --disable-*)
+    ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
+    # Reject names that are not valid shell variable names.
+    if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
+      { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+    fi
+    ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+    eval "enable_${ac_feature}=no" ;;
+
+  -enable-* | --enable-*)
+    ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
+    # Reject names that are not valid shell variable names.
+    if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
+      { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+    fi
+    ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+    case "$ac_option" in
+      *=*) ;;
+      *) ac_optarg=yes ;;
+    esac
+    eval "enable_${ac_feature}='$ac_optarg'" ;;
+
+  -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+  | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+  | --exec | --exe | --ex)
+    ac_prev=exec_prefix ;;
+  -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+  | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+  | --exec=* | --exe=* | --ex=*)
+    exec_prefix="$ac_optarg" ;;
+
+  -gas | --gas | --ga | --g)
+    # Obsolete; use --with-gas.
+    with_gas=yes ;;
+
+  -help | --help | --hel | --he)
+    # Omit some internal or obsolete options to make the list less imposing.
+    # This message is too long to be a string in the A/UX 3.1 sh.
+    cat << EOF
+Usage: configure [options] [host]
+Options: [defaults in brackets after descriptions]
+Configuration:
+  --cache-file=FILE       cache test results in FILE
+  --help                  print this message
+  --no-create             do not create output files
+  --quiet, --silent       do not print \`checking...' messages
+  --version               print the version of autoconf that created configure
+Directory and file names:
+  --prefix=PREFIX         install architecture-independent files in PREFIX
+                          [$ac_default_prefix]
+  --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX
+                          [same as prefix]
+  --bindir=DIR            user executables in DIR [EPREFIX/bin]
+  --sbindir=DIR           system admin executables in DIR [EPREFIX/sbin]
+  --libexecdir=DIR        program executables in DIR [EPREFIX/libexec]
+  --datadir=DIR           read-only architecture-independent data in DIR
+                          [PREFIX/share]
+  --sysconfdir=DIR        read-only single-machine data in DIR [PREFIX/etc]
+  --sharedstatedir=DIR    modifiable architecture-independent data in DIR
+                          [PREFIX/com]
+  --localstatedir=DIR     modifiable single-machine data in DIR [PREFIX/var]
+  --libdir=DIR            object code libraries in DIR [EPREFIX/lib]
+  --includedir=DIR        C header files in DIR [PREFIX/include]
+  --oldincludedir=DIR     C header files for non-gcc in DIR [/usr/include]
+  --infodir=DIR           info documentation in DIR [PREFIX/info]
+  --mandir=DIR            man documentation in DIR [PREFIX/man]
+  --srcdir=DIR            find the sources in DIR [configure dir or ..]
+  --program-prefix=PREFIX prepend PREFIX to installed program names
+  --program-suffix=SUFFIX append SUFFIX to installed program names
+  --program-transform-name=PROGRAM
+                          run sed PROGRAM on installed program names
+EOF
+    cat << EOF
+Host type:
+  --build=BUILD           configure for building on BUILD [BUILD=HOST]
+  --host=HOST             configure for HOST [guessed]
+  --target=TARGET         configure for TARGET [TARGET=HOST]
+Features and packages:
+  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
+  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]
+  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]
+  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)
+  --x-includes=DIR        X include files are in DIR
+  --x-libraries=DIR       X library files are in DIR
+EOF
+    if test -n "$ac_help"; then
+      echo "--enable and --with options recognized:$ac_help"
+    fi
+    exit 0 ;;
+
+  -host | --host | --hos | --ho)
+    ac_prev=host ;;
+  -host=* | --host=* | --hos=* | --ho=*)
+    host="$ac_optarg" ;;
+
+  -includedir | --includedir | --includedi | --included | --include \
+  | --includ | --inclu | --incl | --inc)
+    ac_prev=includedir ;;
+  -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+  | --includ=* | --inclu=* | --incl=* | --inc=*)
+    includedir="$ac_optarg" ;;
+
+  -infodir | --infodir | --infodi | --infod | --info | --inf)
+    ac_prev=infodir ;;
+  -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+    infodir="$ac_optarg" ;;
+
+  -libdir | --libdir | --libdi | --libd)
+    ac_prev=libdir ;;
+  -libdir=* | --libdir=* | --libdi=* | --libd=*)
+    libdir="$ac_optarg" ;;
+
+  -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+  | --libexe | --libex | --libe)
+    ac_prev=libexecdir ;;
+  -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+  | --libexe=* | --libex=* | --libe=*)
+    libexecdir="$ac_optarg" ;;
+
+  -localstatedir | --localstatedir | --localstatedi | --localstated \
+  | --localstate | --localstat | --localsta | --localst \
+  | --locals | --local | --loca | --loc | --lo)
+    ac_prev=localstatedir ;;
+  -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+  | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+  | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+    localstatedir="$ac_optarg" ;;
+
+  -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+    ac_prev=mandir ;;
+  -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+    mandir="$ac_optarg" ;;
+
+  -nfp | --nfp | --nf)
+    # Obsolete; use --without-fp.
+    with_fp=no ;;
+
+  -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+  | --no-cr | --no-c)
+    no_create=yes ;;
+
+  -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+    no_recursion=yes ;;
+
+  -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+  | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+  | --oldin | --oldi | --old | --ol | --o)
+    ac_prev=oldincludedir ;;
+  -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+  | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+  | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+    oldincludedir="$ac_optarg" ;;
+
+  -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+    ac_prev=prefix ;;
+  -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+    prefix="$ac_optarg" ;;
+
+  -program-prefix | --program-prefix | --program-prefi | --program-pref \
+  | --program-pre | --program-pr | --program-p)
+    ac_prev=program_prefix ;;
+  -program-prefix=* | --program-prefix=* | --program-prefi=* \
+  | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+    program_prefix="$ac_optarg" ;;
+
+  -program-suffix | --program-suffix | --program-suffi | --program-suff \
+  | --program-suf | --program-su | --program-s)
+    ac_prev=program_suffix ;;
+  -program-suffix=* | --program-suffix=* | --program-suffi=* \
+  | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+    program_suffix="$ac_optarg" ;;
+
+  -program-transform-name | --program-transform-name \
+  | --program-transform-nam | --program-transform-na \
+  | --program-transform-n | --program-transform- \
+  | --program-transform | --program-transfor \
+  | --program-transfo | --program-transf \
+  | --program-trans | --program-tran \
+  | --progr-tra | --program-tr | --program-t)
+    ac_prev=program_transform_name ;;
+  -program-transform-name=* | --program-transform-name=* \
+  | --program-transform-nam=* | --program-transform-na=* \
+  | --program-transform-n=* | --program-transform-=* \
+  | --program-transform=* | --program-transfor=* \
+  | --program-transfo=* | --program-transf=* \
+  | --program-trans=* | --program-tran=* \
+  | --progr-tra=* | --program-tr=* | --program-t=*)
+    program_transform_name="$ac_optarg" ;;
+
+  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+  | -silent | --silent | --silen | --sile | --sil)
+    silent=yes ;;
+
+  -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+    ac_prev=sbindir ;;
+  -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+  | --sbi=* | --sb=*)
+    sbindir="$ac_optarg" ;;
+
+  -sharedstatedir | --sharedstatedir | --sharedstatedi \
+  | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+  | --sharedst | --shareds | --shared | --share | --shar \
+  | --sha | --sh)
+    ac_prev=sharedstatedir ;;
+  -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+  | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+  | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+  | --sha=* | --sh=*)
+    sharedstatedir="$ac_optarg" ;;
+
+  -site | --site | --sit)
+    ac_prev=site ;;
+  -site=* | --site=* | --sit=*)
+    site="$ac_optarg" ;;
+
+  -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+    ac_prev=srcdir ;;
+  -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+    srcdir="$ac_optarg" ;;
+
+  -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+  | --syscon | --sysco | --sysc | --sys | --sy)
+    ac_prev=sysconfdir ;;
+  -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+  | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+    sysconfdir="$ac_optarg" ;;
+
+  -target | --target | --targe | --targ | --tar | --ta | --t)
+    ac_prev=target ;;
+  -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+    target="$ac_optarg" ;;
+
+  -v | -verbose | --verbose | --verbos | --verbo | --verb)
+    verbose=yes ;;
+
+  -version | --version | --versio | --versi | --vers)
+    echo "configure generated by autoconf version 2.12"
+    exit 0 ;;
+
+  -with-* | --with-*)
+    ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
+    # Reject names that are not valid shell variable names.
+    if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
+      { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+    fi
+    ac_package=`echo $ac_package| sed 's/-/_/g'`
+    case "$ac_option" in
+      *=*) ;;
+      *) ac_optarg=yes ;;
+    esac
+    eval "with_${ac_package}='$ac_optarg'" ;;
+
+  -without-* | --without-*)
+    ac_package=`echo $ac_option|sed -e 's/-*without-//'`
+    # Reject names that are not valid shell variable names.
+    if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
+      { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+    fi
+    ac_package=`echo $ac_package| sed 's/-/_/g'`
+    eval "with_${ac_package}=no" ;;
+
+  --x)
+    # Obsolete; use --with-x.
+    with_x=yes ;;
+
+  -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+  | --x-incl | --x-inc | --x-in | --x-i)
+    ac_prev=x_includes ;;
+  -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+  | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+    x_includes="$ac_optarg" ;;
+
+  -x-libraries | --x-libraries | --x-librarie | --x-librari \
+  | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+    ac_prev=x_libraries ;;
+  -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+  | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+    x_libraries="$ac_optarg" ;;
+
+  -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
+    ;;
+
+  *)
+    if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
+      echo "configure: warning: $ac_option: invalid host type" 1>&2
+    fi
+    if test "x$nonopt" != xNONE; then
+      { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
+    fi
+    nonopt="$ac_option"
+    ;;
+
+  esac
+done
+
+if test -n "$ac_prev"; then
+  { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
+fi
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# File descriptor usage:
+# 0 standard input
+# 1 file creation
+# 2 errors and warnings
+# 3 some systems may open it to /dev/tty
+# 4 used on the Kubota Titan
+# 6 checking for... messages and results
+# 5 compiler messages saved in config.log
+if test "$silent" = yes; then
+  exec 6>/dev/null
+else
+  exec 6>&1
+fi
+exec 5>./config.log
+
+echo "\
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+" 1>&5
+
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell metacharacters.
+ac_configure_args=
+for ac_arg
+do
+  case "$ac_arg" in
+  -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+  | --no-cr | --no-c) ;;
+  -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+  *" "*|*"	"*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+  ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+  *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+  esac
+done
+
+# NLS nuisances.
+# Only set these to C if already set.  These must not be set unconditionally
+# because not all systems understand e.g. LANG=C (notably SCO).
+# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
+# Non-C LC_CTYPE values break the ctype check.
+if test "${LANG+set}"   = set; then LANG=C;   export LANG;   fi
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
+if test "${LC_CTYPE+set}"    = set; then LC_CTYPE=C;    export LC_CTYPE;    fi
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+
+# A filename unique to this package, relative to the directory that
+# configure is in, which we can look for to find out if srcdir is correct.
+ac_unique_file=access_.c
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+  ac_srcdir_defaulted=yes
+  # Try the directory containing this script, then its parent.
+  ac_prog=$0
+  ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
+  test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+  srcdir=$ac_confdir
+  if test ! -r $srcdir/$ac_unique_file; then
+    srcdir=..
+  fi
+else
+  ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+  if test "$ac_srcdir_defaulted" = yes; then
+    { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+  else
+    { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+  fi
+fi
+srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+  if test "x$prefix" != xNONE; then
+    CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+  else
+    CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+  fi
+fi
+for ac_site_file in $CONFIG_SITE; do
+  if test -r "$ac_site_file"; then
+    echo "loading site script $ac_site_file"
+    . "$ac_site_file"
+  fi
+done
+
+if test -r "$cache_file"; then
+  echo "loading cache $cache_file"
+  . $cache_file
+else
+  echo "creating cache $cache_file"
+  > $cache_file
+fi
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+  # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+  if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+    ac_n= ac_c='
+' ac_t='	'
+  else
+    ac_n=-n ac_c= ac_t=
+  fi
+else
+  ac_n= ac_c='\c' ac_t=
+fi
+
+
+
+
+# For g77 we'll set CC to point at the built gcc, but this will get it into
+# the makefiles
+# Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:529: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS="${IFS}:"
+  for ac_dir in $PATH; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      ac_cv_prog_CC="gcc"
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+  echo "$ac_t""$CC" 1>&6
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+if test -z "$CC"; then
+  # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:558: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS="${IFS}:"
+  ac_prog_rejected=no
+  for ac_dir in $PATH; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
+        ac_prog_rejected=yes
+	continue
+      fi
+      ac_cv_prog_CC="cc"
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+if test $ac_prog_rejected = yes; then
+  # We found a bogon in the path, so make sure we never use it.
+  set dummy $ac_cv_prog_CC
+  shift
+  if test $# -gt 0; then
+    # We chose a different compiler from the bogus one.
+    # However, it has the same basename, so the bogon will be chosen
+    # first if we set CC to just the basename; use the full file name.
+    shift
+    set dummy "$ac_dir/$ac_word" "$@"
+    shift
+    ac_cv_prog_CC="$@"
+  fi
+fi
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+  echo "$ac_t""$CC" 1>&6
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+  test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
+echo "configure:606: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+cat > conftest.$ac_ext <<EOF
+#line 616 "configure"
+#include "confdefs.h"
+main(){return(0);}
+EOF
+if { (eval echo configure:620: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+  ac_cv_prog_cc_works=yes
+  # If we can't run a trivial program, we are probably using a cross compiler.
+  if (./conftest; exit) 2>/dev/null; then
+    ac_cv_prog_cc_cross=no
+  else
+    ac_cv_prog_cc_cross=yes
+  fi
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  ac_cv_prog_cc_works=no
+fi
+rm -fr conftest*
+
+echo "$ac_t""$ac_cv_prog_cc_works" 1>&6
+if test $ac_cv_prog_cc_works = no; then
+  { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
+fi
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
+echo "configure:640: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
+echo "configure:645: checking whether we are using GNU C" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.c <<EOF
+#ifdef __GNUC__
+  yes;
+#endif
+EOF
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:654: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+  ac_cv_prog_gcc=yes
+else
+  ac_cv_prog_gcc=no
+fi
+fi
+
+echo "$ac_t""$ac_cv_prog_gcc" 1>&6
+
+if test $ac_cv_prog_gcc = yes; then
+  GCC=yes
+  ac_test_CFLAGS="${CFLAGS+set}"
+  ac_save_CFLAGS="$CFLAGS"
+  CFLAGS=
+  echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
+echo "configure:669: checking whether ${CC-cc} accepts -g" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  echo 'void f(){}' > conftest.c
+if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then
+  ac_cv_prog_cc_g=yes
+else
+  ac_cv_prog_cc_g=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_prog_cc_g" 1>&6
+  if test "$ac_test_CFLAGS" = set; then
+    CFLAGS="$ac_save_CFLAGS"
+  elif test $ac_cv_prog_cc_g = yes; then
+    CFLAGS="-g -O2"
+  else
+    CFLAGS="-O2"
+  fi
+else
+  GCC=
+  test "${CFLAGS+set}" = set || CFLAGS="-g"
+fi
+
+if test "$CROSS";then
+  ac_cv_c_cross=yes
+else
+  ac_cv_c_cross=no
+fi
+
+# Extract the first word of "chmod", so it can be a program name with args.
+set dummy chmod; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:705: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_path_ac_cv_prog_chmod'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  case "$ac_cv_prog_chmod" in
+  /*)
+  ac_cv_path_ac_cv_prog_chmod="$ac_cv_prog_chmod" # Let the user override the test with a path.
+  ;;
+  *)
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS="${IFS}:"
+  for ac_dir in $PATH; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      ac_cv_path_ac_cv_prog_chmod="$ac_dir/$ac_word"
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+  test -z "$ac_cv_path_ac_cv_prog_chmod" && ac_cv_path_ac_cv_prog_chmod="no"
+  ;;
+esac
+fi
+ac_cv_prog_chmod="$ac_cv_path_ac_cv_prog_chmod"
+if test -n "$ac_cv_prog_chmod"; then
+  echo "$ac_t""$ac_cv_prog_chmod" 1>&6
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+if test "$ac_cv_prog_chmod" != no || test "$CROSS"; then
+  MAYBES=chmod_.o
+  cat >> confdefs.h <<EOF
+#define CHMOD_PATH "$ac_cv_prog_chmod"
+EOF
+
+else
+  MAYBES=""
+fi
+
+if test "$ac_cv_c_cross" = yes; then
+  RANLIB=$RANLIB_FOR_TARGET
+  AR=$AR_FOR_TARGET
+  
+else
+  # Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:752: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test -n "$RANLIB"; then
+  ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS="${IFS}:"
+  for ac_dir in $PATH; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      ac_cv_prog_RANLIB="ranlib"
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+  test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
+fi
+fi
+RANLIB="$ac_cv_prog_RANLIB"
+if test -n "$RANLIB"; then
+  echo "$ac_t""$RANLIB" 1>&6
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+  AR=ar
+  RANLIB_TEST=true
+fi
+
+
+
+echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
+echo "configure:785: checking how to run the C preprocessor" >&5
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+  CPP=
+fi
+if test -z "$CPP"; then
+if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+    # This must be in double quotes, not single quotes, because CPP may get
+  # substituted into the Makefile and "${CC-cc}" will confuse make.
+  CPP="${CC-cc} -E"
+  # On the NeXT, cc -E runs the code through the compiler's parser,
+  # not just through cpp.
+  cat > conftest.$ac_ext <<EOF
+#line 800 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:806: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+if test -z "$ac_err"; then
+  :
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  CPP="${CC-cc} -E -traditional-cpp"
+  cat > conftest.$ac_ext <<EOF
+#line 817 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:823: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+if test -z "$ac_err"; then
+  :
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  CPP=/lib/cpp
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+  ac_cv_prog_CPP="$CPP"
+fi
+  CPP="$ac_cv_prog_CPP"
+else
+  ac_cv_prog_CPP="$CPP"
+fi
+echo "$ac_t""$CPP" 1>&6
+
+echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6
+echo "configure:846: checking for ANSI C header files" >&5
+if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 851 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include <float.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:859: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+if test -z "$ac_err"; then
+  rm -rf conftest*
+  ac_cv_header_stdc=yes
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+if test $ac_cv_header_stdc = yes; then
+  # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
+cat > conftest.$ac_ext <<EOF
+#line 876 "configure"
+#include "confdefs.h"
+#include <string.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "memchr" >/dev/null 2>&1; then
+  :
+else
+  rm -rf conftest*
+  ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+  # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
+cat > conftest.$ac_ext <<EOF
+#line 894 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "free" >/dev/null 2>&1; then
+  :
+else
+  rm -rf conftest*
+  ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+  # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
+if test "$cross_compiling" = yes; then
+  :
+else
+  cat > conftest.$ac_ext <<EOF
+#line 915 "configure"
+#include "confdefs.h"
+#include <ctype.h>
+#define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
+#define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
+#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
+int main () { int i; for (i = 0; i < 256; i++)
+if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2);
+exit (0); }
+
+EOF
+if { (eval echo configure:926: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null
+then
+  :
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -fr conftest*
+  ac_cv_header_stdc=no
+fi
+rm -fr conftest*
+fi
+
+fi
+fi
+
+echo "$ac_t""$ac_cv_header_stdc" 1>&6
+if test $ac_cv_header_stdc = yes; then
+  cat >> confdefs.h <<\EOF
+#define STDC_HEADERS 1
+EOF
+
+fi
+
+
+echo $ac_n "checking whether time.h and sys/time.h may both be included""... $ac_c" 1>&6
+echo "configure:951: checking whether time.h and sys/time.h may both be included" >&5
+if eval "test \"`echo '$''{'ac_cv_header_time'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 956 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/time.h>
+#include <time.h>
+int main() {
+struct tm *tp;
+; return 0; }
+EOF
+if { (eval echo configure:965: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  ac_cv_header_time=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_header_time=no
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_header_time" 1>&6
+if test $ac_cv_header_time = yes; then
+  cat >> confdefs.h <<\EOF
+#define TIME_WITH_SYS_TIME 1
+EOF
+
+fi
+
+for ac_hdr in limits.h unistd.h sys/time.h string.h stdlib.h
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:989: checking for $ac_hdr" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 994 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:999: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+if test -z "$ac_err"; then
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=yes"
+else
+  echo "$ac_err" >&5
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+    ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'`
+  cat >> confdefs.h <<EOF
+#define $ac_tr_hdr 1
+EOF
+ 
+else
+  echo "$ac_t""no" 1>&6
+fi
+done
+
+
+echo $ac_n "checking for working const""... $ac_c" 1>&6
+echo "configure:1027: checking for working const" >&5
+if eval "test \"`echo '$''{'ac_cv_c_const'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1032 "configure"
+#include "confdefs.h"
+
+int main() {
+
+/* Ultrix mips cc rejects this.  */
+typedef int charset[2]; const charset x;
+/* SunOS 4.1.1 cc rejects this.  */
+char const *const *ccp;
+char **p;
+/* NEC SVR4.0.2 mips cc rejects this.  */
+struct point {int x, y;};
+static struct point const zero = {0,0};
+/* AIX XL C 1.02.0.0 rejects this.
+   It does not let you subtract one const X* pointer from another in an arm
+   of an if-expression whose if-part is not a constant expression */
+const char *g = "string";
+ccp = &g + (g ? g-g : 0);
+/* HPUX 7.0 cc rejects these. */
+++ccp;
+p = (char**) ccp;
+ccp = (char const *const *) p;
+{ /* SCO 3.2v4 cc rejects this.  */
+  char *t;
+  char const *s = 0 ? (char *) 0 : (char const *) 0;
+
+  *t++ = 0;
+}
+{ /* Someone thinks the Sun supposedly-ANSI compiler will reject this.  */
+  int x[] = {25, 17};
+  const int *foo = &x[0];
+  ++foo;
+}
+{ /* Sun SC1.0 ANSI compiler rejects this -- but not the above. */
+  typedef const int *iptr;
+  iptr p = 0;
+  ++p;
+}
+{ /* AIX XL C 1.02.0.0 rejects this saying
+     "k.c", line 2.27: 1506-025 (S) Operand must be a modifiable lvalue. */
+  struct s { int j; const int *ap[3]; };
+  struct s *b; b->j = 5;
+}
+{ /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */
+  const int foo = 10;
+}
+
+; return 0; }
+EOF
+if { (eval echo configure:1081: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  ac_cv_c_const=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_c_const=no
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_c_const" 1>&6
+if test $ac_cv_c_const = no; then
+  cat >> confdefs.h <<\EOF
+#define const 
+EOF
+
+fi
+
+echo $ac_n "checking for size_t""... $ac_c" 1>&6
+echo "configure:1102: checking for size_t" >&5
+if eval "test \"`echo '$''{'ac_cv_type_size_t'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1107 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "size_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+  rm -rf conftest*
+  ac_cv_type_size_t=yes
+else
+  rm -rf conftest*
+  ac_cv_type_size_t=no
+fi
+rm -f conftest*
+
+fi
+echo "$ac_t""$ac_cv_type_size_t" 1>&6
+if test $ac_cv_type_size_t = no; then
+  cat >> confdefs.h <<\EOF
+#define size_t unsigned
+EOF
+
+fi
+
+echo $ac_n "checking for mode_t""... $ac_c" 1>&6
+echo "configure:1135: checking for mode_t" >&5
+if eval "test \"`echo '$''{'ac_cv_type_mode_t'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1140 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "mode_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+  rm -rf conftest*
+  ac_cv_type_mode_t=yes
+else
+  rm -rf conftest*
+  ac_cv_type_mode_t=no
+fi
+rm -f conftest*
+
+fi
+echo "$ac_t""$ac_cv_type_mode_t" 1>&6
+if test $ac_cv_type_mode_t = no; then
+  cat >> confdefs.h <<\EOF
+#define mode_t int
+EOF
+
+fi
+
+
+echo $ac_n "checking for pid_t""... $ac_c" 1>&6
+echo "configure:1169: checking for pid_t" >&5
+if eval "test \"`echo '$''{'ac_cv_type_pid_t'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1174 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "pid_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+  rm -rf conftest*
+  ac_cv_type_pid_t=yes
+else
+  rm -rf conftest*
+  ac_cv_type_pid_t=no
+fi
+rm -f conftest*
+
+fi
+echo "$ac_t""$ac_cv_type_pid_t" 1>&6
+if test $ac_cv_type_pid_t = no; then
+  cat >> confdefs.h <<\EOF
+#define pid_t int
+EOF
+
+fi
+
+echo $ac_n "checking for st_blksize in struct stat""... $ac_c" 1>&6
+echo "configure:1202: checking for st_blksize in struct stat" >&5
+if eval "test \"`echo '$''{'ac_cv_struct_st_blksize'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1207 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/stat.h>
+int main() {
+struct stat s; s.st_blksize;
+; return 0; }
+EOF
+if { (eval echo configure:1215: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  ac_cv_struct_st_blksize=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_struct_st_blksize=no
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_struct_st_blksize" 1>&6
+if test $ac_cv_struct_st_blksize = yes; then
+  cat >> confdefs.h <<\EOF
+#define HAVE_ST_BLKSIZE 1
+EOF
+
+fi
+
+echo $ac_n "checking for st_blocks in struct stat""... $ac_c" 1>&6
+echo "configure:1236: checking for st_blocks in struct stat" >&5
+if eval "test \"`echo '$''{'ac_cv_struct_st_blocks'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1241 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/stat.h>
+int main() {
+struct stat s; s.st_blocks;
+; return 0; }
+EOF
+if { (eval echo configure:1249: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  ac_cv_struct_st_blocks=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_struct_st_blocks=no
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_struct_st_blocks" 1>&6
+if test $ac_cv_struct_st_blocks = yes; then
+  cat >> confdefs.h <<\EOF
+#define HAVE_ST_BLOCKS 1
+EOF
+
+else
+  LIBOBJS="$LIBOBJS fileblocks.o"
+fi
+
+echo $ac_n "checking for st_rdev in struct stat""... $ac_c" 1>&6
+echo "configure:1272: checking for st_rdev in struct stat" >&5
+if eval "test \"`echo '$''{'ac_cv_struct_st_rdev'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1277 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/stat.h>
+int main() {
+struct stat s; s.st_rdev;
+; return 0; }
+EOF
+if { (eval echo configure:1285: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  ac_cv_struct_st_rdev=yes
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_struct_st_rdev=no
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_struct_st_rdev" 1>&6
+if test $ac_cv_struct_st_rdev = yes; then
+  cat >> confdefs.h <<\EOF
+#define HAVE_ST_RDEV 1
+EOF
+
+fi
+
+echo $ac_n "checking whether struct tm is in sys/time.h or time.h""... $ac_c" 1>&6
+echo "configure:1306: checking whether struct tm is in sys/time.h or time.h" >&5
+if eval "test \"`echo '$''{'ac_cv_struct_tm'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1311 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <time.h>
+int main() {
+struct tm *tp; tp->tm_sec;
+; return 0; }
+EOF
+if { (eval echo configure:1319: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  ac_cv_struct_tm=time.h
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  ac_cv_struct_tm=sys/time.h
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_struct_tm" 1>&6
+if test $ac_cv_struct_tm = sys/time.h; then
+  cat >> confdefs.h <<\EOF
+#define TM_IN_SYS_TIME 1
+EOF
+
+fi
+
+
+
+for ac_func in symlink getcwd getwd lstat gethostname strerror clock getrusage
+do
+echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
+echo "configure:1344: checking for $ac_func" >&5
+if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1349 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char $ac_func(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char $ac_func();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
+choke me
+#else
+$ac_func();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1372: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+  rm -rf conftest*
+  eval "ac_cv_func_$ac_func=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_$ac_func=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+    ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'`
+  cat >> confdefs.h <<EOF
+#define $ac_tr_func 1
+EOF
+ 
+else
+  echo "$ac_t""no" 1>&6
+fi
+done
+
+test $ac_cv_func_symlink = yes && MAYBES="$MAYBES symlnk_.o"
+test $ac_cv_func_lstat = yes && MAYBES="$MAYBES lstat_.o"
+test $ac_cv_func_gethostname = yes && MAYBES="$MAYBES hostnm_.o"
+test $ac_cv_func_clock = yes && MAYBES="$MAYBES mclock_.o"
+
+
+
+
+
+
+
+trap '' 1 2 15
+cat > confcache <<\EOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs.  It is not useful on other systems.
+# If it contains results you don't want to keep, you may remove or edit it.
+#
+# By default, configure uses ./config.cache as the cache file,
+# creating it if it does not exist already.  You can give configure
+# the --cache-file=FILE option to use a different cache file; that is
+# what configure does when it calls configure scripts in
+# subdirectories, so they share the cache.
+# Giving --cache-file=/dev/null disables caching, for debugging configure.
+# config.status only pays attention to the cache file if you give it the
+# --recheck option to rerun configure.
+#
+EOF
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, don't put newlines in cache variables' values.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(set) 2>&1 |
+  case `(ac_space=' '; set) 2>&1` in
+  *ac_space=\ *)
+    # `set' does not quote correctly, so add quotes (double-quote substitution
+    # turns \\\\ into \\, and sed turns \\ into \).
+    sed -n \
+      -e "s/'/'\\\\''/g" \
+      -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
+    ;;
+  *)
+    # `set' quotes correctly as required by POSIX, so do not add quotes.
+    sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
+    ;;
+  esac >> confcache
+if cmp -s $cache_file confcache; then
+  :
+else
+  if test -w $cache_file; then
+    echo "updating cache $cache_file"
+    cat confcache > $cache_file
+  else
+    echo "not updating unwritable cache $cache_file"
+  fi
+fi
+rm -f confcache
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# Any assignment to VPATH causes Sun make to only execute
+# the first set of double-colon rules, so remove it if not needed.
+# If there is a colon in the path, we need to keep it.
+if test "x$srcdir" = x.; then
+  ac_vpsub='/^[ 	]*VPATH[ 	]*=[^:]*$/d'
+fi
+
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+
+DEFS=-DHAVE_CONFIG_H
+
+# Without the "./", some shells look in PATH for config.status.
+: ${CONFIG_STATUS=./config.status}
+
+echo creating $CONFIG_STATUS
+rm -f $CONFIG_STATUS
+cat > $CONFIG_STATUS <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# $0 $ac_configure_args
+#
+# Compiler output produced by configure, useful for debugging
+# configure, is in ./config.log if it exists.
+
+ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
+for ac_option
+do
+  case "\$ac_option" in
+  -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+    echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
+    exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
+  -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
+    echo "$CONFIG_STATUS generated by autoconf version 2.12"
+    exit 0 ;;
+  -help | --help | --hel | --he | --h)
+    echo "\$ac_cs_usage"; exit 0 ;;
+  *) echo "\$ac_cs_usage"; exit 1 ;;
+  esac
+done
+
+ac_given_srcdir=$srcdir
+
+trap 'rm -fr `echo "Makefile config.h" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
+$ac_vpsub
+$extrasub
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@DEFS@%$DEFS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@LIBS@%$LIBS%g
+s%@exec_prefix@%$exec_prefix%g
+s%@prefix@%$prefix%g
+s%@program_transform_name@%$program_transform_name%g
+s%@bindir@%$bindir%g
+s%@sbindir@%$sbindir%g
+s%@libexecdir@%$libexecdir%g
+s%@datadir@%$datadir%g
+s%@sysconfdir@%$sysconfdir%g
+s%@sharedstatedir@%$sharedstatedir%g
+s%@localstatedir@%$localstatedir%g
+s%@libdir@%$libdir%g
+s%@includedir@%$includedir%g
+s%@oldincludedir@%$oldincludedir%g
+s%@infodir@%$infodir%g
+s%@mandir@%$mandir%g
+s%@CC@%$CC%g
+s%@ac_cv_prog_chmod@%$ac_cv_prog_chmod%g
+s%@RANLIB@%$RANLIB%g
+s%@AR@%$AR%g
+s%@CPP@%$CPP%g
+s%@LIBOBJS@%$LIBOBJS%g
+s%@MAYBES@%$MAYBES%g
+s%@CROSS@%$CROSS%g
+s%@RANLIB_TEST@%$RANLIB_TEST%g
+
+CEOF
+EOF
+
+cat >> $CONFIG_STATUS <<\EOF
+
+# Split the substitutions into bite-sized pieces for seds with
+# small command number limits, like on Digital OSF/1 and HP-UX.
+ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
+ac_file=1 # Number of current file.
+ac_beg=1 # First line for current file.
+ac_end=$ac_max_sed_cmds # Line after last line for current file.
+ac_more_lines=:
+ac_sed_cmds=""
+while $ac_more_lines; do
+  if test $ac_beg -gt 1; then
+    sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
+  else
+    sed "${ac_end}q" conftest.subs > conftest.s$ac_file
+  fi
+  if test ! -s conftest.s$ac_file; then
+    ac_more_lines=false
+    rm -f conftest.s$ac_file
+  else
+    if test -z "$ac_sed_cmds"; then
+      ac_sed_cmds="sed -f conftest.s$ac_file"
+    else
+      ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
+    fi
+    ac_file=`expr $ac_file + 1`
+    ac_beg=$ac_end
+    ac_end=`expr $ac_end + $ac_max_sed_cmds`
+  fi
+done
+if test -z "$ac_sed_cmds"; then
+  ac_sed_cmds=cat
+fi
+EOF
+
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile"}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+  # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+  case "$ac_file" in
+  *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+       ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+  *) ac_file_in="${ac_file}.in" ;;
+  esac
+
+  # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
+
+  # Remove last slash and all that follows it.  Not all systems have dirname.
+  ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+  if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+    # The file is in a subdirectory.
+    test ! -d "$ac_dir" && mkdir "$ac_dir"
+    ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
+    # A "../" for each directory in $ac_dir_suffix.
+    ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
+  else
+    ac_dir_suffix= ac_dots=
+  fi
+
+  case "$ac_given_srcdir" in
+  .)  srcdir=.
+      if test -z "$ac_dots"; then top_srcdir=.
+      else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
+  /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
+  *) # Relative path.
+    srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
+    top_srcdir="$ac_dots$ac_given_srcdir" ;;
+  esac
+
+
+  echo creating "$ac_file"
+  rm -f "$ac_file"
+  configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
+  case "$ac_file" in
+  *Makefile*) ac_comsub="1i\\
+# $configure_input" ;;
+  *) ac_comsub= ;;
+  esac
+
+  ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
+  sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
+fi; done
+rm -f conftest.s*
+
+# These sed commands are passed to sed as "A NAME B NAME C VALUE D", where
+# NAME is the cpp macro being defined and VALUE is the value it is being given.
+#
+# ac_d sets the value in "#define NAME VALUE" lines.
+ac_dA='s%^\([ 	]*\)#\([ 	]*define[ 	][ 	]*\)'
+ac_dB='\([ 	][ 	]*\)[^ 	]*%\1#\2'
+ac_dC='\3'
+ac_dD='%g'
+# ac_u turns "#undef NAME" with trailing blanks into "#define NAME VALUE".
+ac_uA='s%^\([ 	]*\)#\([ 	]*\)undef\([ 	][ 	]*\)'
+ac_uB='\([ 	]\)%\1#\2define\3'
+ac_uC=' '
+ac_uD='\4%g'
+# ac_e turns "#undef NAME" without trailing blanks into "#define NAME VALUE".
+ac_eA='s%^\([ 	]*\)#\([ 	]*\)undef\([ 	][ 	]*\)'
+ac_eB='$%\1#\2define\3'
+ac_eC=' '
+ac_eD='%g'
+
+if test "${CONFIG_HEADERS+set}" != set; then
+EOF
+cat >> $CONFIG_STATUS <<EOF
+  CONFIG_HEADERS="config.h"
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+fi
+for ac_file in .. $CONFIG_HEADERS; do if test "x$ac_file" != x..; then
+  # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+  case "$ac_file" in
+  *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+       ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+  *) ac_file_in="${ac_file}.in" ;;
+  esac
+
+  echo creating $ac_file
+
+  rm -f conftest.frag conftest.in conftest.out
+  ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
+  cat $ac_file_inputs > conftest.in
+
+EOF
+
+# Transform confdefs.h into a sed script conftest.vals that substitutes
+# the proper values into config.h.in to produce config.h.  And first:
+# Protect against being on the right side of a sed subst in config.status.
+# Protect against being in an unquoted here document in config.status.
+rm -f conftest.vals
+cat > conftest.hdr <<\EOF
+s/[\\&%]/\\&/g
+s%[\\$`]%\\&%g
+s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%${ac_dA}\1${ac_dB}\1${ac_dC}\2${ac_dD}%gp
+s%ac_d%ac_u%gp
+s%ac_u%ac_e%gp
+EOF
+sed -n -f conftest.hdr confdefs.h > conftest.vals
+rm -f conftest.hdr
+
+# This sed command replaces #undef with comments.  This is necessary, for
+# example, in the case of _POSIX_SOURCE, which is predefined and required
+# on some systems where configure will not decide to define it.
+cat >> conftest.vals <<\EOF
+s%^[ 	]*#[ 	]*undef[ 	][ 	]*[a-zA-Z_][a-zA-Z_0-9]*%/* & */%
+EOF
+
+# Break up conftest.vals because some shells have a limit on
+# the size of here documents, and old seds have small limits too.
+
+rm -f conftest.tail
+while :
+do
+  ac_lines=`grep -c . conftest.vals`
+  # grep -c gives empty output for an empty file on some AIX systems.
+  if test -z "$ac_lines" || test "$ac_lines" -eq 0; then break; fi
+  # Write a limited-size here document to conftest.frag.
+  echo '  cat > conftest.frag <<CEOF' >> $CONFIG_STATUS
+  sed ${ac_max_here_lines}q conftest.vals >> $CONFIG_STATUS
+  echo 'CEOF
+  sed -f conftest.frag conftest.in > conftest.out
+  rm -f conftest.in
+  mv conftest.out conftest.in
+' >> $CONFIG_STATUS
+  sed 1,${ac_max_here_lines}d conftest.vals > conftest.tail
+  rm -f conftest.vals
+  mv conftest.tail conftest.vals
+done
+rm -f conftest.vals
+
+cat >> $CONFIG_STATUS <<\EOF
+  rm -f conftest.frag conftest.h
+  echo "/* $ac_file.  Generated automatically by configure.  */" > conftest.h
+  cat conftest.in >> conftest.h
+  rm -f conftest.in
+  if cmp -s $ac_file conftest.h 2>/dev/null; then
+    echo "$ac_file is unchanged"
+    rm -f conftest.h
+  else
+    # Remove last slash and all that follows it.  Not all systems have dirname.
+      ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+      if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+      # The file is in a subdirectory.
+      test ! -d "$ac_dir" && mkdir "$ac_dir"
+    fi
+    rm -f $ac_file
+    mv conftest.h $ac_file
+  fi
+fi; done
+
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
diff --git a/gcc/f/runtime/libU77/configure.in b/gcc/f/runtime/libU77/configure.in
new file mode 100644
index 00000000000..d50fa118e93
--- /dev/null
+++ b/gcc/f/runtime/libU77/configure.in
@@ -0,0 +1,111 @@
+# Process this file with autoconf to produce a configure script.
+#   Copyright (C) 1995 Free Software Foundation, Inc.
+#   Contributed by Dave Love (d.love@dl.ac.uk).
+#
+#This file is part of the GNU Fortran libU77 library.
+#
+#This library 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 Library General Public License for more details.
+#
+#You should have received a copy of the GNU Library General Public
+#License along with GNU Fortran; see the file COPYING.  If not, write
+#to Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307,
+#USA.
+
+AC_INIT(access_.c)
+AC_CONFIG_HEADER(config.h)
+
+dnl Checks for programs.
+# For g77 we'll set CC to point at the built gcc, but this will get it into
+# the makefiles
+AC_PROG_CC
+dnl AC_C_CROSS
+dnl Gives misleading `(cached)' message from the check.
+if test "$CROSS";then
+  ac_cv_c_cross=yes
+else
+  ac_cv_c_cross=no
+fi
+
+dnl This is only because we (horribly) punt the chmod job to the program at
+dnl present.  Note that the result of this test could be wrong in the cross
+dnl case.
+AC_PATH_PROG(ac_cv_prog_chmod, chmod, no)
+if test "$ac_cv_prog_chmod" != no || test "$CROSS"; then
+  MAYBES=chmod_.o
+  AC_DEFINE_UNQUOTED(CHMOD_PATH,"$ac_cv_prog_chmod")
+else
+  MAYBES=""
+fi
+
+dnl for g77 build maybe use $(RANLIB_FOR_TARGET) always (like wise AR)
+if test "$ac_cv_c_cross" = yes; then
+  RANLIB=$RANLIB_FOR_TARGET
+  AR=$AR_FOR_TARGET
+  AC_SUBST(RANLIB)
+else
+  AC_PROG_RANLIB
+  AR=ar
+  RANLIB_TEST=true
+fi
+AC_SUBST(AR)
+dnl not needed for g77
+dnl AC_SUBST(AR_FOR_TARGET)
+dnl AC_SUBST(RANLIB_FOR_TARGET)
+dnl AC_SUBST(RANLIB_TEST_FOR_TARGET)
+dnl not needed for g77?
+dnl AC_PROG_MAKE_SET
+
+dnl Checks for libraries.
+
+dnl Checks for header files.
+AC_HEADER_STDC
+dnl We could do this if we didn't know we were using gcc
+dnl AC_MSG_CHECKING(for prototype-savvy compiler)
+dnl AC_CACHE_VAL(ac_cv_sys_proto,                
+dnl   [AC_TRY_LINK(,                             
+dnl dnl looks screwy because TRY_LINK expects a function body
+dnl    [return 0;} int foo (int * bar) {],       
+dnl    ac_cv_sys_proto=yes,                      
+dnl    [ac_cv_sys_proto=no                       
+dnl     AC_DEFINE(KR_headers)])])                
+dnl AC_MSG_RESULT($ac_cv_sys_proto)              
+
+AC_HEADER_TIME
+AC_CHECK_HEADERS(limits.h unistd.h sys/time.h string.h stdlib.h)
+
+dnl Checks for typedefs, structures, and compiler characteristics.
+AC_C_CONST
+AC_TYPE_SIZE_T
+AC_TYPE_MODE_T
+
+AC_TYPE_PID_T
+dnl The next 3 demand a dummy fileblocks.o (added to LIBOJS).  We don't use
+dnl LIBOJS, though.
+AC_STRUCT_ST_BLKSIZE
+AC_STRUCT_ST_BLOCKS
+AC_STRUCT_ST_RDEV
+AC_STRUCT_TM
+
+dnl Checks for library functions.
+
+AC_CHECK_FUNCS(symlink getcwd getwd lstat gethostname strerror clock getrusage)
+test $ac_cv_func_symlink = yes && MAYBES="$MAYBES symlnk_.o"
+test $ac_cv_func_lstat = yes && MAYBES="$MAYBES lstat_.o"
+test $ac_cv_func_gethostname = yes && MAYBES="$MAYBES hostnm_.o"
+test $ac_cv_func_clock = yes && MAYBES="$MAYBES mclock_.o"
+AC_SUBST(MAYBES)
+
+
+AC_SUBST(CROSS)
+AC_SUBST(RANLIB)
+AC_SUBST(RANLIB_TEST)
+
+AC_OUTPUT(Makefile)
diff --git a/gcc/f/runtime/libU77/ctime_.c b/gcc/f/runtime/libU77/ctime_.c
new file mode 100644
index 00000000000..af5813772af
--- /dev/null
+++ b/gcc/f/runtime/libU77/ctime_.c
@@ -0,0 +1,57 @@
+/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#if TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+#  include <sys/time.h>
+# else
+#  include <time.h>
+# endif
+#endif
+#if HAVE_STRING_H
+#  include <string.h>
+#else
+#  include <strings.h>
+#endif
+#include "f2c.h"
+
+/* may need sys/time.h & long arg for stime (bsd, svr1-3) */
+
+#ifdef KR_headers
+/* Character */ void G77_ctime_0 (chtime, Lchtime, xstime)
+     char *chtime;
+     longint * xstime;
+     ftnlen Lchtime;
+#else
+/* Character */ void G77_ctime_0 (char *chtime, const ftnlen Lchtime, longint * xstime)
+#endif
+{
+  int i, l;
+  int s_copy ();
+  time_t stime = *xstime;
+
+  /* Allow a length other than 24 for compatibility with what other
+     systems do, despite it being documented as 24. */
+  s_copy (chtime, ctime (&stime), Lchtime, 24);
+}
diff --git a/gcc/f/runtime/libU77/date_.c b/gcc/f/runtime/libU77/date_.c
new file mode 100644
index 00000000000..8426edc4fb0
--- /dev/null
+++ b/gcc/f/runtime/libU77/date_.c
@@ -0,0 +1,39 @@
+/* date_.f -- translated by f2c (version 19961001).
+   You must link the resulting object file with the libraries:
+	-lf2c -lm   (in that order)
+*/
+
+#include "f2c.h"
+
+/* Table of constant values */
+
+static integer c__5 = 5;
+
+/* Subroutine */ int G77_date_0 (char *buf, ftnlen buf_len)
+{
+    /* System generated locals */
+    address a__1[5];
+    integer i__1, i__2[5];
+    char ch__1[24];
+
+    /* Builtin functions */
+    /* Subroutine */ int s_copy(), s_cat();
+
+    /* Local variables */
+    static char cbuf[24];
+    extern integer G77_time_0 ();
+    extern /* Character */ VOID G77_ctime_0 ();
+
+    i__1 = G77_time_0 ();
+    G77_ctime_0 (ch__1, 24L, &i__1);
+    s_copy(cbuf, ch__1, 24L, 24L);
+/* Writing concatenation */
+    i__2[0] = 2, a__1[0] = cbuf + 8;
+    i__2[1] = 1, a__1[1] = "-";
+    i__2[2] = 3, a__1[2] = cbuf + 4;
+    i__2[3] = 1, a__1[3] = "-";
+    i__2[4] = 2, a__1[4] = cbuf + 22;
+    s_cat(buf, a__1, i__2, &c__5, buf_len);
+    return 0;
+} /* date_ */
+
diff --git a/gcc/f/runtime/libU77/dbes.c b/gcc/f/runtime/libU77/dbes.c
new file mode 100644
index 00000000000..2330b50489b
--- /dev/null
+++ b/gcc/f/runtime/libU77/dbes.c
@@ -0,0 +1,46 @@
+/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#include "f2c.h"
+#include <math.h>
+
+#if 0 	/* Don't include these unless necessary -- dnp. */
+doublereal G77_dbesj0_0 (const double *x) {
+    return j0 (*x);
+}
+
+doublereal G77_dbesj1_0 (const double *x) {
+    return j1 (*x);
+}
+
+doublereal G77_dbesjn_0 (const integer *n, double *x) {
+     return jn (*n, *x);
+ }
+
+doublereal G77_dbesy0_0 (const double *x) {
+    return y0 (*x);
+}
+
+doublereal G77_dbesy1_0 (const double *x) {
+    return y1 (*x);
+}
+
+doublereal G77_dbesyn_0 (const integer *n, double *x) {
+    return yn (*n, *x);
+}
+#endif
diff --git a/gcc/f/runtime/libU77/dtime_.c b/gcc/f/runtime/libU77/dtime_.c
new file mode 100644
index 00000000000..e04ada1eca2
--- /dev/null
+++ b/gcc/f/runtime/libU77/dtime_.c
@@ -0,0 +1,82 @@
+/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#if HAVE_UNISTD_H
+#  include <unistd.h>
+#endif
+#include <sys/times.h>
+#if HAVE_GETRUSAGE
+#  include <sys/time.h>
+#  include <sys/resource.h>
+#endif
+#include "f2c.h"
+
+/* For dtime, etime we store the clock tick parameter (clk_tck) the
+   first time either of them is invoked rather than each time.  This
+   approach probably speeds up each invocation by avoiding a system
+   call each time, but means that the overhead of the first call is
+   different to all others. */
+static long clk_tck = 0;
+
+#ifdef KR_headers
+doublereal G77_dtime_0 (tarray)
+     real tarray[2];
+#else
+doublereal G77_dtime_0 (real tarray[2])
+#endif
+{
+  time_t utime, stime;
+  static time_t old_utime = 0, old_stime = 0;
+  /* The getrusage version is only the default for convenience. */
+#ifdef HAVE_GETRUSAGE
+  struct rusage rbuff;
+
+   if (getrusage (RUSAGE_SELF, &rbuff) != 0)
+     abort ();
+   utime = ((float) (rbuff.ru_utime).tv_sec +
+	   (float) (rbuff.ru_utime).tv_usec/1000000.0);
+   tarray[0] = utime - (float) old_utime;
+   stime = ((float) (rbuff.ru_stime).tv_sec +
+	   (float) (rbuff.ru_stime).tv_usec/1000000.0);
+  tarray[1] = stime - old_stime;
+#else  /* HAVE_GETRUSAGE */
+  struct tms buffer;
+
+/* NeXTStep seems to define _SC_CLK_TCK but not to have sysconf;
+   fixme: does using _POSIX_VERSION help? */
+#  if defined _SC_CLK_TCK && defined _POSIX_VERSION
+  if (! clk_tck) clk_tck = sysconf(_SC_CLK_TCK);
+#  elif defined CLOCKS_PER_SECOND
+  if (! clk_tck) clk_tck = CLOCKS_PER_SECOND;
+#  elif defined CLK_TCK
+  if (! clk_tck) clk_tck = CLK_TCK;
+#  elif defined HAVE_GETRUSAGE
+#  else
+  #error Dont know clock tick length
+#  endif
+  if (times(&buffer) < 0) return -1.0;
+  utime = buffer.tms_utime; stime = buffer.tms_stime;
+  tarray[0] = ((float)(utime - old_utime)) / (float)clk_tck;
+  tarray[1] = ((float)(stime - old_stime)) / (float)clk_tck;
+#endif /* HAVE_GETRUSAGE */
+  old_utime = utime; old_stime = stime;
+  return (tarray[0]+tarray[1]);
+}
diff --git a/gcc/f/runtime/libU77/etime_.c b/gcc/f/runtime/libU77/etime_.c
new file mode 100644
index 00000000000..36e68133a24
--- /dev/null
+++ b/gcc/f/runtime/libU77/etime_.c
@@ -0,0 +1,78 @@
+/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#if HAVE_UNISTD_H
+#  include <unistd.h>
+#endif
+#include <sys/types.h>
+#include <sys/times.h>
+#include <sys/param.h>
+#if HAVE_GETRUSAGE
+#  include <sys/time.h>
+#  include <sys/resource.h>
+#endif
+#include "f2c.h"
+
+/* For dtime, etime we store the clock tick parameter (clk_tck) the
+   first time either of them is invoked rather than each time.  This
+   approach probably speeds up each invocation by avoiding a system
+   call each time, but means that the overhead of the first call is
+   different to all others. */
+static long clk_tck = 0;
+
+#ifdef KR_headers
+doublereal G77_etime_0 (tarray)
+     real tarray[2];
+#else
+doublereal G77_etime_0 (real tarray[2])
+#endif
+{
+  /* The getrusage version is only the default for convenience. */
+#ifdef HAVE_GETRUSAGE
+  struct rusage rbuff;
+
+   if (getrusage (RUSAGE_SELF, &rbuff) != 0)
+     abort ();
+   tarray[0] = ((float) (rbuff.ru_utime).tv_sec +
+	       (float) (rbuff.ru_utime).tv_usec/1000000.0);
+   tarray[1] = ((float) (rbuff.ru_stime).tv_sec +
+	       (float) (rbuff.ru_stime).tv_usec/1000000.0);
+#else  /* HAVE_GETRUSAGE */
+  struct tms buffer;
+
+/* NeXTStep seems to define _SC_CLK_TCK but not to have sysconf;
+   fixme: does using _POSIX_VERSION help? */
+#  if defined _SC_CLK_TCK && defined _POSIX_VERSION
+  if (! clk_tck) clk_tck = sysconf(_SC_CLK_TCK);
+#  elif defined CLOCKS_PER_SECOND
+  if (! clk_tck) clk_tck = CLOCKS_PER_SECOND;
+#  elif defined CLK_TCK
+  if (! clk_tck) clk_tck = CLK_TCK;
+#  elif defined HAVE_GETRUSAGE
+#  else
+  #error Dont know clock tick length
+#  endif
+  if (times(&buffer) < 0) return -1.0;
+  tarray[0] = (float) buffer.tms_utime / (float)clk_tck;
+  tarray[1] = (float) buffer.tms_stime / (float)clk_tck;
+#endif /* HAVE_GETRUSAGE */
+  return (tarray[0]+tarray[1]);
+}
diff --git a/gcc/f/runtime/libU77/fdate_.c b/gcc/f/runtime/libU77/fdate_.c
new file mode 100644
index 00000000000..afe8b24fc44
--- /dev/null
+++ b/gcc/f/runtime/libU77/fdate_.c
@@ -0,0 +1,53 @@
+/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include <stdio.h>
+#if TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+#  include <sys/time.h>
+# else
+#  include <time.h>
+# endif
+#endif
+#if HAVE_STRING_H
+#  include <string.h>
+#else
+#  include <strings.h>
+#endif
+
+#include "f2c.h"
+
+/* NB. this implementation is for a character*24 function.  There's
+   also a subroutine version.  Of course, the calling convention is
+   essentially the same for both. */
+
+/* Character *24 */ void G77_fdate_0 (char *ret_val, ftnlen ret_val_len)
+{
+    int s_copy ();
+    time_t tloc;
+    tloc = time (NULL);
+    /* Allow a length other than 24 for compatibility with what other
+       systems do, despite it being documented as 24. */
+    s_copy (ret_val, ctime ((time_t *) &tloc), ret_val_len, 24);
+}
diff --git a/gcc/f/runtime/libU77/fgetc_.c b/gcc/f/runtime/libU77/fgetc_.c
new file mode 100644
index 00000000000..49f39830d2c
--- /dev/null
+++ b/gcc/f/runtime/libU77/fgetc_.c
@@ -0,0 +1,70 @@
+/* Copyright (C) 1996 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include <stdio.h>
+#include "f2c.h"
+#include "fio.h"
+
+#ifdef KR_headers
+integer G77_fgetc_0 (lunit, c, Lc)
+     integer *lunit;
+     ftnlen Lc;			/* should be 1 */
+     char *c;
+#else
+integer G77_fgetc_0 (const integer *lunit, char *c, ftnlen Lc)
+#endif
+{
+  int err;
+  FILE *f = f__units[*lunit].ufd;
+
+  if (*lunit>=MXUNIT || *lunit<0)
+    return 101;			/* bad unit error */
+  err = getc (f);
+  if (err == EOF) {
+    if (feof (f))
+      return -1;
+    else
+      return ferror (f); }
+  else {
+    if (Lc == 0)
+      return 0;
+
+    c[0] = err;
+    while (--Lc)
+      *++c = ' ';
+    return 0; }
+}
+
+#ifdef KR_headers
+integer G77_fget_0 (c, Lc)
+     ftnlen Lc;			/* should be 1 */
+     char *c;
+#else
+integer G77_fget_0 (char *c, const ftnlen Lc)
+#endif
+{
+  integer five = 5;
+
+  return G77_fgetc_0 (&five, c, Lc);
+}
diff --git a/gcc/f/runtime/libU77/flush1_.c b/gcc/f/runtime/libU77/flush1_.c
new file mode 100644
index 00000000000..451915debac
--- /dev/null
+++ b/gcc/f/runtime/libU77/flush1_.c
@@ -0,0 +1,46 @@
+/* Copyright (C) 1995 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include <stdio.h>
+#include "f2c.h"
+#include "fio.h"
+
+/* This flushes a single unit, c.f. libI77 version. */
+
+#ifdef KR_headers
+extern integer G77_fnum_0 ();
+
+/* Subroutine */ int G77_flush1_0 (lunit)
+     integer *lunit;
+#else
+extern integer G77_fnum_0 (integer *);
+
+/* Subroutine */ int G77_flush1_0 (const integer *lunit)
+#endif
+{
+  if (*lunit>=MXUNIT || *lunit<0)
+    err(1,101,"flush");
+  /* f__units is a table of descriptions for the unit numbers (defined
+     in io.h) with file descriptors rather than streams */
+  if (f__units[*lunit].ufd != NULL && f__units[*lunit].uwrt)
+    fflush(f__units[*lunit].ufd);
+  return 0;
+}
diff --git a/gcc/f/runtime/libU77/fnum_.c b/gcc/f/runtime/libU77/fnum_.c
new file mode 100644
index 00000000000..0a3ba013e06
--- /dev/null
+++ b/gcc/f/runtime/libU77/fnum_.c
@@ -0,0 +1,38 @@
+/* Copyright (C) 1995 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include "f2c.h"
+#include "fio.h"
+
+#ifdef KR_headers
+integer G77_fnum_0 (lunit)
+     integer *lunit;
+#else
+integer G77_fnum_0 (integer *lunit)
+#endif
+{
+  if (*lunit>=MXUNIT || *lunit<0)
+    err(1,101,"fnum");
+  /* f__units is a table of descriptions for the unit numbers (defined
+     in io.h).  Use file descriptor (ufd) and fileno rather than udev
+     field since udev is unix specific */
+  return fileno(f__units[*lunit].ufd);
+}
diff --git a/gcc/f/runtime/libU77/fputc_.c b/gcc/f/runtime/libU77/fputc_.c
new file mode 100644
index 00000000000..5a1109e8d4f
--- /dev/null
+++ b/gcc/f/runtime/libU77/fputc_.c
@@ -0,0 +1,65 @@
+/* Copyright (C) 1996 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include <stdio.h>
+#include "f2c.h"
+#include "fio.h"
+
+#ifdef KR_headers
+integer G77_fputc_0 (lunit, c, Lc)
+     integer *lunit;
+     ftnlen Lc;			/* should be 1 */
+     char *c;
+#else
+integer G77_fputc_0 (const integer *lunit, const char *c, const ftnlen Lc)
+#endif
+{
+  int err;
+  FILE *f = f__units[*lunit].ufd;
+
+  if (*lunit>=MXUNIT || *lunit<0)
+    return 101;			/* bad unit error */
+  err = putc (c[0], f);
+  if (err == EOF) {
+    if (feof (f))
+      return -1;
+    else
+      return ferror (f);
+  }
+  else
+    return 0;
+}
+
+#ifdef KR_headers
+integer G77_fput_0 (c, Lc)
+     ftnlen Lc;			/* should be 1 */
+     char *c;
+#else
+integer G77_fput_0 (const char *c, const ftnlen Lc)
+#endif
+{
+  integer six = 6;
+
+  return G77_fputc_0 (&six, c, Lc);
+}
diff --git a/gcc/f/runtime/libU77/fstat_.c b/gcc/f/runtime/libU77/fstat_.c
new file mode 100644
index 00000000000..da5434ad0b7
--- /dev/null
+++ b/gcc/f/runtime/libU77/fstat_.c
@@ -0,0 +1,71 @@
+/* Copyright (C) 1995 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include "f2c.h"
+#include <sys/types.h>
+#include <sys/stat.h>
+
+#ifdef KR_headers
+extern integer G77_fnum_0 ();
+
+integer G77_fstat_0 (lunit, statb)
+     integer *lunit;
+     integer statb[13];
+#else
+extern integer G77_fnum_0 (const integer *);
+
+integer G77_fstat_0 (const integer *lunit, integer statb[13])
+#endif
+{
+  int err;
+  struct stat buf;
+
+  err = fstat (G77_fnum_0 (lunit), &buf);
+  statb[0] = buf.st_dev;
+  statb[1] = buf.st_ino;
+  statb[2] = buf.st_mode;
+  statb[3] = buf.st_nlink;
+  statb[4] = buf.st_uid;
+  statb[5] = buf.st_gid;
+#if HAVE_ST_RDEV
+  statb[6] = buf.st_rdev;	/* not posix */
+#else
+  statb[6] = 0;
+#endif
+  statb[7] = buf.st_size;
+  statb[8] = buf.st_atime;
+  statb[9] = buf.st_mtime;
+  statb[10] = buf.st_ctime;
+#if HAVE_ST_BLKSIZE
+  statb[11] = buf.st_blksize;	/* not posix */
+#else
+  statb[11] = -1;
+#endif
+#if HAVE_ST_BLOCKS
+  statb[12] = buf.st_blocks;	/* not posix */
+#else
+  statb[12] = -1;
+#endif
+  return err;
+}
diff --git a/gcc/f/runtime/libU77/gerror_.c b/gcc/f/runtime/libU77/gerror_.c
new file mode 100644
index 00000000000..6f5943c1dce
--- /dev/null
+++ b/gcc/f/runtime/libU77/gerror_.c
@@ -0,0 +1,49 @@
+/* Copyright (C) 1995 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include <errno.h>
+#include <stddef.h>
+#if HAVE_STRING_H
+#  include <string.h>
+#else
+#  include <strings.h>
+#endif
+#include "f2c.h"
+
+#ifndef HAVE_STRERROR
+     extern char *sys_errlist [];
+#    define strerror(i) (sys_errlist[i])
+#endif
+#ifdef KR_headers
+extern void s_copy ();
+/* Subroutine */ int G77_gerror_0 (str, Lstr)
+     char *str; ftnlen Lstr;
+#else
+extern void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb);
+/* Subroutine */ int G77_gerror_0 (char *str, ftnlen Lstr)
+#endif
+{
+  char * s;
+
+  s = strerror(errno);
+  s_copy (str, s, Lstr, strlen (s));
+  return 0;
+}
diff --git a/gcc/f/runtime/libU77/getcwd_.c b/gcc/f/runtime/libU77/getcwd_.c
new file mode 100644
index 00000000000..e01b22c698d
--- /dev/null
+++ b/gcc/f/runtime/libU77/getcwd_.c
@@ -0,0 +1,98 @@
+/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include <errno.h>
+#if HAVE_STRING_H
+#  include <string.h>
+#else
+#  include <strings.h>
+#endif
+#include <stdio.h>		/* for NULL */
+#include "f2c.h"
+
+#if HAVE_GETCWD
+
+#ifdef HAVE_UNISTD_H
+#  include <unistd.h>
+#else
+  extern char *getcwd ();
+#endif
+
+#ifdef KR_headers
+extern void s_copy ();
+integer G77_getcwd_0 (str, Lstr)
+     char *str; ftnlen Lstr;
+#else
+extern void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb);
+integer G77_getcwd_0 (char *str, const ftnlen Lstr)
+#endif
+{
+    int i;
+    char *ret;
+
+    ret = getcwd (str, Lstr);
+    if (ret == NULL) return errno;
+    for (i=strlen(str); i<Lstr; i++)
+	str[i] = ' ';
+    return 0;
+}
+
+#elif HAVE_GETWD		/* HAVE_GETCWD */
+
+/* getwd usage taken from SunOS4 man */
+
+#  include <sys/param.h>
+  extern char *getwd ();
+#ifdef KR_headers
+extern VOID s_copy ();
+integer G77_getcwd_0 (str, Lstr)
+     char *str; ftnlen Lstr;
+#else
+extern void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb);
+integer G77_getcwd_0 (char *str, const ftnlen Lstr)
+#endif
+{
+  char pathname[MAXPATHLEN];
+  size_t l;
+
+  if (getwd (pathname) == NULL) {
+    return errno;
+  } else {
+    s_copy (str, pathname, Lstr, strlen (str));
+    return 0;
+  }
+}
+
+#else  /* !HAVE_GETWD && !HAVE_GETCWD */
+
+#ifdef KR_headers
+extern VOID s_copy ();
+integer G77_getcwd_0 (str, Lstr)
+     char *str; ftnlen Lstr;
+#else
+extern void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb);
+integer G77_getcwd_0 (char *str, const ftnlen Lstr)
+#endif
+{
+  return errno = ENOSYS;
+}
+
+#endif
diff --git a/gcc/f/runtime/libU77/getgid_.c b/gcc/f/runtime/libU77/getgid_.c
new file mode 100644
index 00000000000..02e8a4e4895
--- /dev/null
+++ b/gcc/f/runtime/libU77/getgid_.c
@@ -0,0 +1,35 @@
+/* Copyright (C) 1995 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#if HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+#include <sys/types.h>
+#include "f2c.h"
+
+#ifdef KR_headers
+integer G77_getgid_0 ()
+#else
+integer G77_getgid_0 (void)
+#endif
+{
+  return getgid ();
+}
diff --git a/gcc/f/runtime/libU77/getlog_.c b/gcc/f/runtime/libU77/getlog_.c
new file mode 100644
index 00000000000..a2c5f20f28b
--- /dev/null
+++ b/gcc/f/runtime/libU77/getlog_.c
@@ -0,0 +1,62 @@
+/* Copyright (C) 1995 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#if HAVE_STDLIB_H
+#  include <stdlib.h>
+#else
+#  include <stdio.h>
+#endif
+#include <stdio.h>
+#if HAVE_UNISTD_H
+#  include <unistd.h>
+#endif
+#if HAVE_STRING_H
+#  include <string.h>
+#else
+#  include <strings.h>
+#endif
+#include "f2c.h"
+
+/* getlogin not in svr1-3 */
+
+/* SGI also has character*(*) function getlog() */
+
+#ifdef KR_headers
+extern VOID s_copy ();
+/* Subroutine */ int G77_getlog_0 (str, Lstr)
+     char *str; ftnlen Lstr;
+#else
+extern void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb);
+/* Subroutine */ int G77_getlog_0 (char *str, const ftnlen Lstr)
+#endif
+{
+  size_t i;
+  char *p;
+
+  p = getlogin ();
+  if (p != NULL) {
+    i = strlen (p);
+    s_copy (str, p, Lstr, i);
+  } else {
+    s_copy (str, " ", Lstr, 1);
+  }
+  return 0;
+}
diff --git a/gcc/f/runtime/libU77/getpid_.c b/gcc/f/runtime/libU77/getpid_.c
new file mode 100644
index 00000000000..fa484785957
--- /dev/null
+++ b/gcc/f/runtime/libU77/getpid_.c
@@ -0,0 +1,35 @@
+/* Copyright (C) 1995 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#if HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+#include <sys/types.h>
+#include "f2c.h"
+
+#ifdef KR_headers
+integer G77_getpid_0 ()
+#else
+integer G77_getpid_0 (void)
+#endif
+{
+  return getpid ();
+}
diff --git a/gcc/f/runtime/libU77/getuid_.c b/gcc/f/runtime/libU77/getuid_.c
new file mode 100644
index 00000000000..421bb4c9362
--- /dev/null
+++ b/gcc/f/runtime/libU77/getuid_.c
@@ -0,0 +1,35 @@
+/* Copyright (C) 1995 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#if HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+#include <sys/types.h>
+#include "f2c.h"
+
+#ifdef KR_headers
+integer G77_getuid_0 ()
+#else
+integer G77_getuid_0 (void)
+#endif
+{
+  return getuid ();
+}
diff --git a/gcc/f/runtime/libU77/gmtime_.c b/gcc/f/runtime/libU77/gmtime_.c
new file mode 100644
index 00000000000..5f6f8ec6a0b
--- /dev/null
+++ b/gcc/f/runtime/libU77/gmtime_.c
@@ -0,0 +1,54 @@
+/* Copyright (C) 1995 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+/* fixme: do we need to use TM_IN_SYS_TIME? */
+#if TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+#  include <sys/time.h>
+# else
+#  include <time.h>
+# endif
+#endif
+#include "f2c.h"
+
+#ifdef KR_headers
+/* Subroutine */ int G77_gmtime_0 (stime, tarray)
+     integer *stime, tarray[9];
+#else
+/* Subroutine */ int G77_gmtime_0 (const integer * stime, integer tarray[9])
+#endif
+{
+  struct tm *lt;
+  lt = gmtime ((time_t *) stime);
+  tarray[0] = lt->tm_sec;
+  tarray[1] = lt->tm_min;
+  tarray[2] = lt->tm_hour;
+  tarray[3] = lt->tm_mday;
+  tarray[4] = lt->tm_mon;
+  tarray[5] = lt->tm_year;
+  tarray[6] = lt->tm_wday;
+  tarray[7] = lt->tm_yday;
+  tarray[8] = lt->tm_isdst;
+  return 0;
+}
diff --git a/gcc/f/runtime/libU77/hostnm_.c b/gcc/f/runtime/libU77/hostnm_.c
new file mode 100644
index 00000000000..2a7b590a358
--- /dev/null
+++ b/gcc/f/runtime/libU77/hostnm_.c
@@ -0,0 +1,48 @@
+/* Copyright (C) 1995 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#if HAVE_STRING_H
+#  include <string.h>
+#else
+#  include <strings.h>
+#endif
+#if HAVE_UNISTD_H
+#  include <unistd.h>
+#endif
+#include "f2c.h"
+
+integer G77_hostnm_0 (char *name, ftnlen Lname)
+{
+    int ret, i;
+
+#if HAVE_GETHOSTNAME
+    ret = gethostname (name, Lname);
+    if (ret==0) {
+	/* Pad with blanks (assuming gethostname will make an error
+           return if it can't fit in the null). */
+	for (i=strlen(name); i<=Lname; i++)
+	    name[i] = ' ';
+    }
+    return ret;
+#else
+    return errno = ENOSYS;
+#endif
+}
diff --git a/gcc/f/runtime/libU77/idate_.c b/gcc/f/runtime/libU77/idate_.c
new file mode 100644
index 00000000000..c4075767a4c
--- /dev/null
+++ b/gcc/f/runtime/libU77/idate_.c
@@ -0,0 +1,57 @@
+/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include <stdio.h>
+#if TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+#  include <sys/time.h>
+# else
+#  include <time.h>
+# endif
+#endif
+#include "f2c.h"
+
+/* VMS and Irix versions (at least) differ from libU77 elsewhere */
+
+/* libU77 one: */
+
+#ifdef KR_headers
+/* Subroutine */ int G77_idate_0 (iarray)
+     int iarray[3];
+#else
+/* Subroutine */ int G77_idate_0 (int iarray[3])
+#endif
+{
+  struct tm *lt;
+  time_t tim;
+  tim = time(NULL);
+  lt = localtime(&tim);
+  iarray[0] = lt->tm_mday;
+  iarray[1] = lt->tm_mon + 1;	/* in range 1-12 in SunOS (experimentally) */
+  /* The `+1900' is consistent with SunOS and Irix, but they don't say
+     it's added.  I think I've seen a system where tm_year was since
+     1970, but can't now verify that, so assume the ANSI definition. */
+  iarray[2] = lt->tm_year + 1900;
+  return 0;
+}
diff --git a/gcc/f/runtime/libU77/ierrno_.c b/gcc/f/runtime/libU77/ierrno_.c
new file mode 100644
index 00000000000..557b53a4664
--- /dev/null
+++ b/gcc/f/runtime/libU77/ierrno_.c
@@ -0,0 +1,32 @@
+/* Copyright (C) 1995 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include <errno.h>
+#include "f2c.h"
+
+#ifdef KR_headers
+integer G77_ierrno_0 ()
+#else
+integer G77_ierrno_0 (void)
+#endif
+{
+  return errno;
+}
diff --git a/gcc/f/runtime/libU77/irand_.c b/gcc/f/runtime/libU77/irand_.c
new file mode 100644
index 00000000000..2bf14ccee26
--- /dev/null
+++ b/gcc/f/runtime/libU77/irand_.c
@@ -0,0 +1,57 @@
+/* Copyright (C) 1995 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#if HAVE_STDLIB_H
+#  include <stdlib.h>
+#endif
+#include "f2c.h"
+
+/* We could presumably do much better than the traditional libc
+   version, though at least the glibc one is reasonable, it seems.
+   For the sake of the innocent, I'm not sure we should really do
+   this... */
+
+/* Note this is per SunOS -- other s may have no arg. */
+
+#ifdef KR_headers
+integer G77_irand_0 (flag)
+  integer *flag;
+#else
+integer G77_irand_0 (integer *flag)
+#endif
+{
+  switch (*flag) {
+  case 0:
+    break;
+  case 1:
+    srand (0);			/* Arbitrary choice of initialiser. */
+    break;
+  default:
+    srand (*flag);
+  }
+  return rand ();
+}
+
+
+
+
+
+
diff --git a/gcc/f/runtime/libU77/isatty_.c b/gcc/f/runtime/libU77/isatty_.c
new file mode 100644
index 00000000000..92c33468f53
--- /dev/null
+++ b/gcc/f/runtime/libU77/isatty_.c
@@ -0,0 +1,44 @@
+/* Copyright (C) 1995 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#if HAVE_UNISTD_H
+#  include <unistd.h>
+#endif
+#include "f2c.h"
+#include "fio.h"
+
+#ifdef KR_headers
+extern integer G77_fnum_0 ();
+
+logical G77_isatty_0 (lunit)
+     integer *lunit;
+#else
+extern integer G77_fnum_0 (integer *);
+
+logical G77_isatty_0 (integer *lunit)
+#endif
+{
+  if (*lunit>=MXUNIT || *lunit<0)
+    err(1,101,"isatty");
+  /* f__units is a table of descriptions for the unit numbers (defined
+     in io.h) with file descriptors rather than streams */
+  return (isatty(G77_fnum_0 (lunit)) ? TRUE_ : FALSE_);
+}
diff --git a/gcc/f/runtime/libU77/itime_.c b/gcc/f/runtime/libU77/itime_.c
new file mode 100644
index 00000000000..50378d54426
--- /dev/null
+++ b/gcc/f/runtime/libU77/itime_.c
@@ -0,0 +1,51 @@
+/* Copyright (C) 1995 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include <stdio.h>
+#if TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+#  include <sys/time.h>
+# else
+#  include <time.h>
+# endif
+#endif
+#include "f2c.h"
+
+#ifdef KR_headers
+/* Subroutine */ int G77_itime_0 (tarray)
+     integer tarray[3];
+#else
+/* Subroutine */ int G77_itime_0 (integer tarray[3])
+#endif
+{
+  struct tm *lt;
+  time_t tim;
+
+  tim = time(NULL);
+  lt = localtime(&tim);
+  tarray[0] = lt->tm_hour;
+  tarray[1] = lt->tm_min;
+  tarray[2] = lt->tm_sec;
+  return 0;
+}
diff --git a/gcc/f/runtime/libU77/kill_.c b/gcc/f/runtime/libU77/kill_.c
new file mode 100644
index 00000000000..32afddf1e46
--- /dev/null
+++ b/gcc/f/runtime/libU77/kill_.c
@@ -0,0 +1,37 @@
+/* Copyright (C) 1995 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include <sys/types.h>
+#include <signal.h>
+#include <errno.h>
+#include "f2c.h"
+
+/* fixme: bsd, svr1-3 use int, not pid_t */
+
+#ifdef KR_headers
+integer G77_kill_0 (pid, signum)
+     integer *pid, *signum;
+#else
+integer G77_kill_0 (const integer *pid, const integer *signum)
+#endif
+{
+  return kill ((pid_t) *pid, *signum) ? errno : 0;
+}
diff --git a/gcc/f/runtime/libU77/link_.c b/gcc/f/runtime/libU77/link_.c
new file mode 100644
index 00000000000..6892dcb7694
--- /dev/null
+++ b/gcc/f/runtime/libU77/link_.c
@@ -0,0 +1,58 @@
+/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#if HAVE_STDLIB_H
+#  include <stdlib.h>
+#else
+#  include <stdio.h>
+#endif
+#if HAVE_UNISTD_H
+#  include <unistd.h>
+#endif
+#include <errno.h>
+#include <sys/param.h>
+#include "f2c.h"
+
+#ifdef KR_headers
+void g_char ();
+
+integer G77_link_0 (path1, path2, Lpath1, Lpath2)
+     char *path1, *path2; ftnlen Lpath1, Lpath2;
+#else
+void g_char(const char *a, ftnlen alen, char *b);
+
+integer G77_link_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2)
+#endif
+{
+  char *buff1, *buff2;
+  char *bp, *blast;
+  int i;
+
+  buff1 = malloc (Lpath1+1);
+  if (buff1 == NULL) return -1;
+  g_char (path1, Lpath1, buff1);
+  buff2 = malloc (Lpath2+1);
+  if (buff2 == NULL) return -1;
+  g_char (path2, Lpath2, buff2);
+  i = link (buff1, buff2);
+  free (buff1); free (buff2);
+  return i ? errno : 0;
+}
diff --git a/gcc/f/runtime/libU77/lnblnk_.c b/gcc/f/runtime/libU77/lnblnk_.c
new file mode 100644
index 00000000000..806eca293f1
--- /dev/null
+++ b/gcc/f/runtime/libU77/lnblnk_.c
@@ -0,0 +1,35 @@
+/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+
+/* via f2c from Fortran */
+
+#include "f2c.h"
+
+integer G77_lnblnk_0 (char *str, ftnlen str_len)
+{
+    integer ret_val;
+    integer i_len();
+
+    for (ret_val = str_len; ret_val >= 1; --ret_val) {
+	if (*(unsigned char *)&str[ret_val - 1] != ' ') {
+	    return ret_val;
+	}
+    }
+    return ret_val;
+}
diff --git a/gcc/f/runtime/libU77/lstat_.c b/gcc/f/runtime/libU77/lstat_.c
new file mode 100644
index 00000000000..17f0c1a6b3a
--- /dev/null
+++ b/gcc/f/runtime/libU77/lstat_.c
@@ -0,0 +1,86 @@
+/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include <stdio.h>
+#if HAVE_STDLIB_H
+#  include <stdlib.h>
+#endif
+#include <sys/types.h>
+#include <sys/stat.h>
+#include "f2c.h"
+
+/* lstat isn't posix */
+
+#ifdef KR_headers
+void g_char();
+
+integer G77_lstat_0 (name, statb, Lname)
+     char *name;
+     integer statb[13];
+     ftnlen Lname;
+#else
+void g_char(const char *a, ftnlen alen, char *b);
+
+integer G77_lstat_0 (const char *name, integer statb[13], const ftnlen Lname)
+#endif
+{
+#if HAVE_LSTAT
+  char *buff;
+  char *bp, *blast;
+  int err;
+  struct stat buf;
+
+  buff = malloc (Lname+1);
+  if (buff == NULL) return -1;
+  g_char (name, Lname, buff);
+  err = lstat (buff, &buf);
+  free (buff);
+  statb[0] = buf.st_dev;
+  statb[1] = buf.st_ino;
+  statb[2] = buf.st_mode;
+  statb[3] = buf.st_nlink;
+  statb[4] = buf.st_uid;
+  statb[5] = buf.st_gid;
+#if HAVE_ST_RDEV
+  statb[6] = buf.st_rdev;
+#else
+  statb[6] = 0;
+#endif
+  statb[7] = buf.st_size;
+  statb[8] = buf.st_atime;
+  statb[9] = buf.st_mtime;
+  statb[10] = buf.st_ctime;
+  statb[6] = 0;
+#if HAVE_ST_BLKSIZE
+  statb[11] = buf.st_blksize;
+#else
+  statb[11] = -1;
+#endif
+#if HAVE_ST_BLOCKS
+  statb[12] = buf.st_blocks;
+#else
+  statb[12] = -1;
+#endif
+  return err;
+#else	/* !HAVE_LSTAT */
+  return errno = ENOSYS;
+#endif	/* !HAVE_LSTAT */
+}
diff --git a/gcc/f/runtime/libU77/ltime_.c b/gcc/f/runtime/libU77/ltime_.c
new file mode 100644
index 00000000000..151ac6c9b55
--- /dev/null
+++ b/gcc/f/runtime/libU77/ltime_.c
@@ -0,0 +1,54 @@
+/* Copyright (C) 1995 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+/* fixme: do we need to use TM_IN_SYS_TIME? */
+#if TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+#  include <sys/time.h>
+# else
+#  include <time.h>
+# endif
+#endif
+#include "f2c.h"
+
+#ifdef KR_headers
+/* Subroutine */ int G77_ltime_0 (stime, tarray)
+     integer *stime, tarray[9];
+#else
+/* Subroutine */ int G77_ltime_0 (const integer * stime, integer tarray[9])
+#endif
+{
+  struct tm *lt;
+  lt = localtime ((time_t *) stime);
+  tarray[0] = lt->tm_sec;
+  tarray[1] = lt->tm_min;
+  tarray[2] = lt->tm_hour;
+  tarray[3] = lt->tm_mday;
+  tarray[4] = lt->tm_mon;
+  tarray[5] = lt->tm_year;
+  tarray[6] = lt->tm_wday;
+  tarray[7] = lt->tm_yday;
+  tarray[8] = lt->tm_isdst;
+  return 0;
+}
diff --git a/gcc/f/runtime/libU77/mclock_.c b/gcc/f/runtime/libU77/mclock_.c
new file mode 100644
index 00000000000..6b7e81b1e04
--- /dev/null
+++ b/gcc/f/runtime/libU77/mclock_.c
@@ -0,0 +1,47 @@
+/* Copyright (C) 1996 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#if TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+#  include <sys/time.h>
+# else
+#  include <time.h>
+# endif
+#endif
+#include "f2c.h"
+
+/* Reported by wd42ej@sgi83.wwb.noaa.gov (Russ Jones AUTO-Sun3) on AIX. */
+
+#ifdef KR_headers
+longint G77_mclock_0 ()
+#else
+longint G77_mclock_0 (void)
+#endif
+{
+#if HAVE_CLOCK
+  return clock ();
+#else
+  return -1;
+#endif
+}
diff --git a/gcc/f/runtime/libU77/perror_.c b/gcc/f/runtime/libU77/perror_.c
new file mode 100644
index 00000000000..26d8582dbcc
--- /dev/null
+++ b/gcc/f/runtime/libU77/perror_.c
@@ -0,0 +1,48 @@
+/* Copyright (C) 1995 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include <stdio.h>
+#include <errno.h>
+#if HAVE_STRING_H
+#  include <string.h>
+#else
+#  include <strings.h>
+#endif
+#include "f2c.h"
+
+#ifdef KR_headers
+/* Subroutine */ int G77_perror_0 (str, Lstr)
+     char *str; ftnlen Lstr;
+#else
+/* Subroutine */ int G77_perror_0 (const char *str, const ftnlen Lstr)
+#endif
+{
+  char buff[1000];
+  char *bp, *blast;
+
+  /* same technique as `system' -- what's wrong with malloc? */
+  blast = buff + (Lstr < 1000 ? Lstr : 1000);
+  for (bp = buff ; bp<blast && *str!='\0' ; )
+    *bp++ = *str++;
+  *bp = '\0';
+  perror (buff);
+  return 0;
+}
diff --git a/gcc/f/runtime/libU77/rand_.c b/gcc/f/runtime/libU77/rand_.c
new file mode 100644
index 00000000000..1c533a39fdd
--- /dev/null
+++ b/gcc/f/runtime/libU77/rand_.c
@@ -0,0 +1,54 @@
+/* Copyright (C) 1995 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#if HAVE_STDLIB_H
+#  include <stdlib.h>
+#endif
+#include "f2c.h"
+#ifndef RAND_MAX
+#  define RAND_MAX 2147483647	/* from SunOS */
+#endif
+
+/* We could presumably do much better than the traditional libc
+   version, though at least the glibc one is reasonable, it seems.
+   For the sake of the innocent, I'm not sure we should really do
+   this... */
+
+/* Note this is per SunOS -- other s may have no arg. */
+
+#ifdef KR_headers
+doublereal G77_rand_0 (flag)
+  integer *flag;
+#else
+doublereal G77_rand_0 (integer *flag)
+#endif
+{
+  switch (*flag) {
+  case 0:
+    break;
+  case 1:
+    srand (0);			/* Arbitrary choice of initialiser. */
+    break;
+  default:
+    srand (*flag);
+  }
+  return (float) rand () / RAND_MAX;
+}
diff --git a/gcc/f/runtime/libU77/rename_.c b/gcc/f/runtime/libU77/rename_.c
new file mode 100644
index 00000000000..e8a4bf6523c
--- /dev/null
+++ b/gcc/f/runtime/libU77/rename_.c
@@ -0,0 +1,53 @@
+/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#if HAVE_STDLIB_H
+#  include <stdlib.h>
+#endif
+#include <stdio.h>
+#include <errno.h>
+#include "f2c.h"
+
+#ifdef KR_headers
+void g_char ();
+
+integer G77_rename_0 (path1, path2, Lpath1, Lpath2)
+     char *path1, *path2; ftnlen Lpath1, Lpath2;
+#else
+void g_char(const char *a, ftnlen alen, char *b);
+
+integer G77_rename_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2)
+#endif
+{
+  char *buff1, *buff2;
+  char *bp, *blast;
+  int i;
+
+  buff1 = malloc (Lpath1+1);
+  if (buff1 == NULL) return -1;
+  g_char (path1, Lpath1, buff1);
+  buff2 = malloc (Lpath2+1);
+  if (buff2 == NULL) return -1;
+  g_char (path2, Lpath2, buff2);
+  i = rename (buff1, buff2);
+  free (buff1); free (buff2);
+  return i ? errno : 0;
+}
diff --git a/gcc/f/runtime/libU77/secnds_.c b/gcc/f/runtime/libU77/secnds_.c
new file mode 100644
index 00000000000..64eb76e2fb9
--- /dev/null
+++ b/gcc/f/runtime/libU77/secnds_.c
@@ -0,0 +1,51 @@
+/* Copyright (C) 1995 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include <stdio.h>
+#if TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+#  include <sys/time.h>
+# else
+#  include <time.h>
+# endif
+#endif
+#include <sys/types.h>
+
+#include "f2c.h"
+
+/* This is a VMS intrinsic. */
+
+doublereal G77_secnds_0 (real *r)
+{
+    struct tm *lt;
+    time_t clock;
+    float f;
+
+    clock = time (NULL);
+    lt = localtime (&clock);
+    f= (3600.0*((real)lt->tm_hour) + 60.0*((real)lt->tm_min) +
+	    (real)lt->tm_sec - *r);
+    return f;
+}
+
diff --git a/gcc/f/runtime/libU77/second_.c b/gcc/f/runtime/libU77/second_.c
new file mode 100644
index 00000000000..a984cf9e3d2
--- /dev/null
+++ b/gcc/f/runtime/libU77/second_.c
@@ -0,0 +1,26 @@
+/* Copyright (C) 1996 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#include "f2c.h"
+
+doublereal G77_second_0 () {
+  extern doublereal G77_etime_0 ();
+  real tarray[2];
+
+  return G77_etime_0 (tarray);
+}
diff --git a/gcc/f/runtime/libU77/sleep_.c b/gcc/f/runtime/libU77/sleep_.c
new file mode 100644
index 00000000000..36e1b8d9a7b
--- /dev/null
+++ b/gcc/f/runtime/libU77/sleep_.c
@@ -0,0 +1,37 @@
+/* Copyright (C) 1995 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#if HAVE_UNISTD_H
+#  include <unistd.h>
+#endif
+#include "f2c.h"
+
+/* Subroutine */
+#ifdef KR_headers
+int G77_sleep_0 (seconds)
+     integer *seconds;
+#else
+int G77_sleep_0 (const integer *seconds)
+#endif
+{
+  (void) sleep ((unsigned int) *seconds);
+  return 0;
+}
diff --git a/gcc/f/runtime/libU77/srand_.c b/gcc/f/runtime/libU77/srand_.c
new file mode 100644
index 00000000000..8edc62e4fe0
--- /dev/null
+++ b/gcc/f/runtime/libU77/srand_.c
@@ -0,0 +1,37 @@
+/* Copyright (C) 1995 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#if STDC_HEADERS
+#  include <stdlib.h>
+#endif
+#include "f2c.h"
+
+/* Subroutine */ 
+#ifdef KR_headers
+int G77_srand_0 (seed)
+     integer *seed;
+#else
+int G77_srand_0 (const integer *seed)
+#endif
+{
+  srand ((unsigned int) *seed);
+  return 0;
+}
diff --git a/gcc/f/runtime/libU77/stat_.c b/gcc/f/runtime/libU77/stat_.c
new file mode 100644
index 00000000000..b24f3892221
--- /dev/null
+++ b/gcc/f/runtime/libU77/stat_.c
@@ -0,0 +1,79 @@
+/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include <stdio.h>
+#if HAVE_STDLIB_H
+#  include <stdlib.h>
+#endif
+#include <sys/types.h>
+#include <sys/stat.h>
+#include "f2c.h"
+
+#ifdef KR_headers
+void g_char ();
+
+integer G77_stat_0 (name, statb, Lname)
+     char *name;
+     integer statb[13];
+     ftnlen Lname;
+#else
+void g_char(const char *a, ftnlen alen, char *b);
+
+integer G77_stat_0 (const char *name, integer statb[13], const ftnlen Lname)
+#endif
+{
+  char *buff;
+  char *bp, *blast;
+  int err;
+  struct stat buf;
+
+  buff = malloc (Lname+1);
+  if (buff == NULL) return -1;
+  g_char (name, Lname, buff);
+  err = stat (buff, &buf);
+  free (buff);
+  statb[0] = buf.st_dev;
+  statb[1] = buf.st_ino;
+  statb[2] = buf.st_mode;
+  statb[3] = buf.st_nlink;
+  statb[4] = buf.st_uid;
+  statb[5] = buf.st_gid;
+#if HAVE_ST_RDEV
+  statb[6] = buf.st_rdev;	/* not posix */
+#else
+  statb[6] = 0;
+#endif
+  statb[7] = buf.st_size;
+  statb[8] = buf.st_atime;
+  statb[9] = buf.st_mtime;
+  statb[10] = buf.st_ctime;
+#if HAVE_ST_BLKSIZE
+  statb[11] = buf.st_blksize;	/* not posix */
+#else
+  statb[11] = -1;
+#endif
+#if HAVE_ST_BLOCKS
+  statb[12] = buf.st_blocks;	/* not posix */
+#else
+  statb[12] = -1;
+#endif
+  return err;
+}
diff --git a/gcc/f/runtime/libU77/symlnk_.c b/gcc/f/runtime/libU77/symlnk_.c
new file mode 100644
index 00000000000..d15e4528758
--- /dev/null
+++ b/gcc/f/runtime/libU77/symlnk_.c
@@ -0,0 +1,62 @@
+/* Copyright (C) 1995, 1997 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 Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#if HAVE_STDLIB_H
+#  include <stdlib.h>
+#else
+#  include <stdio.h>
+#endif
+#if HAVE_UNISTD_H
+#  include <unistd.h>
+#endif
+#include <errno.h>
+#include <sys/param.h>
+#include "f2c.h"
+
+#ifdef KR_headers
+void g_char ();
+
+integer G77_symlnk_0 (path1, path2, Lpath1, Lpath2)
+     char *path1, *path2; ftnlen Lpath1, Lpath2;
+#else
+void g_char(const char *a, ftnlen alen, char *b);
+
+integer G77_symlnk_0 (const char *path1, const char *path2, const ftnlen Lpath1, const ftnlen Lpath2)
+#endif
+{
+#if HAVE_SYMLINK
+  char *buff1, *buff2;
+  char *bp, *blast;
+  int i;
+
+  buff1 = (char *) malloc (Lpath1+1);
+  if (buff1 == NULL) return -1;
+  g_char (path1, Lpath1, buff1);
+  buff2 = (char *) malloc (Lpath2+1);
+  if (buff2 == NULL) return -1;
+  g_char (path2, Lpath2, buff2);
+  i = symlink (buff1, buff2);
+  free (buff1); free (buff2);
+  return i ? errno : 0;
+#else	/* !HAVE_SYMLINK */
+  return errno = ENOSYS;
+#endif	/* !HAVE_SYMLINK */
+}
diff --git a/gcc/f/runtime/libU77/system_clock_.c b/gcc/f/runtime/libU77/system_clock_.c
new file mode 100644
index 00000000000..d5cbaac0608
--- /dev/null
+++ b/gcc/f/runtime/libU77/system_clock_.c
@@ -0,0 +1,64 @@
+/* Copyright (C) 1996 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#if TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+#  include <sys/time.h>
+# else
+#  include <time.h>
+# endif
+#endif
+#include <sys/times.h>
+#include <limits.h>
+#if HAVE_UNISTD_H
+#  include <unistd.h>
+#endif
+#include "f2c.h"
+
+#ifdef KR_headers
+int G77_system_clock_0 (count, count_rate, count_max)
+     integer *count, *count_rate, *count_max;
+#else
+int G77_system_clock_0 (integer *count, integer *count_rate, integer *count_max)
+#endif
+{
+  struct tms buffer;
+  unsigned long cnt;
+#ifdef _SC_CLK_TCK
+  *count_rate = sysconf(_SC_CLK_TCK);
+#elif defined CLOCKS_PER_SECOND
+  *count_rate = CLOCKS_PER_SECOND;
+#elif defined CLK_TCK
+  *count_rate = CLK_TCK;
+#else
+  #error Dont know clock tick length
+#endif
+  *count_max = INT_MAX;		/* dubious */
+  cnt = times (&buffer);
+  if (cnt > (unsigned long) (*count_max))
+    *count = *count_max;	/* also dubious */
+  else
+    *count = cnt;
+  return 0;
+}
diff --git a/gcc/f/runtime/libU77/time_.c b/gcc/f/runtime/libU77/time_.c
new file mode 100644
index 00000000000..73894b0b413
--- /dev/null
+++ b/gcc/f/runtime/libU77/time_.c
@@ -0,0 +1,46 @@
+/* Copyright (C) 1995 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include <stdio.h>
+#if TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+#  include <sys/time.h>
+# else
+#  include <time.h>
+# endif
+#endif
+#include "f2c.h"
+
+/* As well as this external function some compilers have an intrinsic
+   subroutine which fills a character argument (which is the VMS way)
+   -- caveat emptor. */
+#ifdef KR_headers
+longint G77_time_0 ()
+#else
+longint G77_time_0 (void)
+#endif
+{
+  /* There are potential problems with the cast of the time_t here. */
+  return time (NULL);
+}
diff --git a/gcc/f/runtime/libU77/ttynam_.c b/gcc/f/runtime/libU77/ttynam_.c
new file mode 100644
index 00000000000..f69aa43f564
--- /dev/null
+++ b/gcc/f/runtime/libU77/ttynam_.c
@@ -0,0 +1,57 @@
+/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#if STDC_HEADERS
+#  include <stdlib.h>
+#endif
+#if HAVE_UNISTD_H
+#  include <unistd.h>		/* POSIX for ttyname */
+#endif
+#include <stdio.h>
+#if HAVE_STRING_H
+#  include <string.h>
+#else
+#  include <strings.h>
+#endif
+#include "f2c.h"
+
+#ifdef KR_headers
+extern void s_copy ();
+extern integer G77_fnum_0 ();
+/* Character */ void G77_ttynam_0 (ret_val, ret_val_len, lunit)
+     char *ret_val; ftnlen ret_val_len; integer *lunit
+#else
+extern integer G77_fnum_0 (integer *lunit);
+extern void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb);
+/* Character */ void G77_ttynam_0 (char *ret_val, ftnlen ret_val_len, integer *lunit)
+#endif
+{
+  size_t i;
+  char *p;
+
+  p = ttyname (G77_fnum_0 (lunit));
+  if (p != NULL) {
+    i = strlen (p);
+    s_copy (ret_val, p, ret_val_len, i);
+  } else {
+    s_copy (ret_val, " ", ret_val_len, 1);
+  }
+}
diff --git a/gcc/f/runtime/libU77/u77-test.f b/gcc/f/runtime/libU77/u77-test.f
new file mode 100644
index 00000000000..11c5ecae449
--- /dev/null
+++ b/gcc/f/runtime/libU77/u77-test.f
@@ -0,0 +1,178 @@
+***   Some random stuff for testing libU77.  Should be done better.  It's
+*     hard to test things where you can't guarantee the result.  Have a
+*     good squint at what it prints, though detected errors will cause 
+*     starred messages.
+
+      integer i, j, k, ltarray (9), idat (3), count, rate, count_max,
+     +     pid
+      real tarray1(2), tarray2(2), r1, r2, etime
+      intrinsic getpid, getuid, getgid, ierrno, gerror,
+     +     fnum, isatty, getarg, access, unlink, fstat,
+     +     stat, lstat, getcwd, gmtime, hostnm, etime, chmod,
+     +     chdir, fgetc, fputc, system_clock, second, idate, secnds,
+     +     time, ctime, fdate, ttynam
+      external lenstr
+      logical l
+      character gerr*80, c*1
+      character ctim*25, line*80, lognam*20, wd*100, line2*80
+      integer fstatb (13), statb (13)
+      integer *2 i2zero
+
+      ctim = ctime(time())
+      WRITE (6,'(A/)') '1 GNU libU77 test at: ' // ctim
+      write (6,'(A,I3,'', '',I3)')
+     +     ' Logical units 5 and 6 correspond (FNUM) to'
+     +     // ' Unix i/o units ', fnum(5), fnum(6)
+      if (lnblnk('foo ').ne.3 .or. len_trim('foo ').ne.3) then
+        print *, 'LNBLNK or LEN_TRIM failed'
+        call exit(1)
+      end if
+      l= isatty(6)
+      line2 = ttynam(6)
+      if (l) then
+        line = 'and 6 is a tty device (ISATTY) named '//line2
+      else
+        line = 'and 6 isn''t a tty device (ISATTY)'
+      end if
+      write (6,'(1X,A)') line(:lenstr(line))
+      pid = getpid()
+      WRITE (6,'(A,I10)') ' Process id (GETPID): ', pid
+      WRITE (6,'(A,I10)') ' User id (GETUID): ', GETUID ()
+      WRITE (6,'(A,I10)') ' Group id (GETGID): ', GETGID ()
+      WRITE (6,*) 'If you have the `id'' program, the following call of'
+     +     // ' SYSTEM should agree with the above'
+      call flush(6)
+      CALL SYSTEM ('echo " " `id`')
+      call flush
+      call getlog (lognam)
+      write (6,*) 'Login name (GETLOG): ', lognam
+      call umask(0, mask)
+      write(6,*) 'UMASK returns', mask
+      call umask(mask)
+      ctim = fdate()
+      write (6,*) 'FDATE returns: ', ctim
+      j=time()
+      call ltime (j, ltarray)
+      write (6,'(1x,a,9i4)') 'LTIME returns:', ltarray
+      call gmtime (j, ltarray)
+      write (6,'(1x,a,9i4)') 'GMTIME returns:', ltarray
+      call system_clock(count, rate, count_max)
+      write(6,*) 'SYSTEM_CLOCK returns: ', count, rate, count_max
+      write (6,*) 'Sleeping for 1 second (SLEEP) ...'
+      call sleep (1)
+      write (6,*) 'Looping 10,000,000 times ...'
+      do i=1,10*1000*1000
+      end do
+      r1= etime (tarray1)
+      if (r1.ne.tarray1(1)+tarray1(2))
+     +     write (6,*) '*** ETIME didn''t return sum of the array: ',
+     +     r1, ' /= ', tarray1
+      r2= dtime (tarray2)
+      if (abs (r1-r2).gt.1.0) write (6,*)
+     +     'Results of ETIME and DTIME differ by more than a second:',
+     +     i, j
+      write (6,'(A,3F10.3)')
+     +     ' Elapsed total, user, system time (ETIME): ',
+     +     r1, tarray1
+      call idate(i,j,k)
+      call idate (idat)
+      write (6,*) 'IDATE d,m,y: ',idat
+      print *,  '... and the VXT version: ', i,j,k
+      call time(line(:8))
+      print *, line(:8)
+      write (6,*) 'SECNDS(0.0) returns: ',secnds(0.0)
+      write (6,*) 'SECOND returns: ', second()
+      call dumdum(r1)
+      call second(r1)
+      write (6,*) 'CALL SECOND returns: ', r1
+      i = getcwd(wd)
+      if (i.ne.0) then
+        call perror ('*** getcwd')
+      else
+        write (6,*) 'Current directory is "'//wd(:lenstr(wd))//'"'
+      end if
+      call chdir ('.',i)
+      if (i.ne.0) write (6,*) '***CHDIR to ".": ', i
+      i=hostnm(wd)
+      if(i.ne.0) then
+        call perror ('*** hostnm')
+      else
+        write (6,*) 'Host name is ', wd(:lenstr(wd))
+      end if
+      i = access('/dev/null ', 'rw')
+      if (i.ne.0) write (6,*) '***Read/write ACCESS to /dev/null: ', i
+      write (6,*) 'Creating file "foo" for testing...'
+      open (3,file='foo',status='UNKNOWN')
+      rewind 3
+      call fputc(3, 'c',i)
+      call fputc(3, 'd',j)      
+      if (i+j.ne.0) write(6,*) '***FPUTC: ', i
+C     why is it necessary to reopen?
+      close(3)
+      open(3,file='foo',status='old')
+      call fseek(3,0,0,*10)
+      go to 20
+ 10   write(6,*) '***FSEEK failed'
+ 20   call fgetc(3, c,i)
+      if (i.ne.0) write(6,*) '***FGETC: ', i
+      if (c.ne.'c') write(6,*) '***FGETC read the wrong thing: ',
+     +     ichar(c)
+      i= ftell(3)
+      if (i.ne.1) write(6,*) '***FTELL offset: ', i
+      call chmod ('foo', 'a+w',i)
+      if (i.ne.0) write (6,*) '***CHMOD of "foo": ', i
+      i = fstat (3, fstatb)
+      if (i.ne.0) write (6,*) '***FSTAT of "foo": ', i
+      i = stat ('foo', statb)
+      if (i.ne.0) write (6,*) '***STAT of "foo": ', i
+      write (6,*) '  with stat array ', statb
+      if (statb(5).ne.getuid () .or. statb(6).ne.getgid() .or. statb(4)
+     +     .ne. 1) write (6,*) '*** FSTAT uid, gid or nlink is wrong'
+      do i=1,13
+        if (fstatb (i) .ne. statb (i))
+     +       write (6,*) '*** FSTAT and STAT don''t agree on '// '
+     +       array element ', i, ' value ', fstatb (i), statb (i)
+      end do
+      i = lstat ('foo', fstatb)
+      do i=1,13
+        if (fstatb (i) .ne. statb (i))
+     +       write (6,*) '*** LSTAT and STAT don''t agree on '// '
+     +       array element ', i, ' value ', fstatb (i), statb (i)
+      end do
+
+C     in case it exists already:
+      call unlink ('bar',i)
+      call link ('foo ', 'bar ',i)
+      if (i.ne.0)
+     +     write (6,*) '***LINK "foo" to "bar" failed: ', i
+      call unlink ('foo',i)
+      if (i.ne.0) write (6,*) '***UNLINK "foo" failed: ', i
+      call unlink ('foo',i)
+      if (i.eq.0) write (6,*) '***UNLINK "foo" again: ', i
+      call gerror (gerr)
+      i = ierrno()
+      write (6,'(A,I3,A/1X,A)') ' The current error number is: ',
+     +     i,
+     +     ' and the corresponding message is:', gerr(:lenstr(gerr))
+      write (6,*) 'This is sent to stderr prefixed by the program name'
+      call getarg (0, line)
+      call perror (line (:lenstr (line)))
+      call unlink ('bar')
+      WRITE (6,*) 'You should see exit status 1'
+      CALL EXIT(1)
+ 99   END
+
+      integer function lenstr (str)
+C     return length of STR not including trailing blanks, but always
+C     return >0
+      character *(*) str
+      if (str.eq.' ') then
+        lenstr=1
+      else
+        lenstr = lnblnk (str)
+      end if
+      end
+* just make sure SECOND() doesn't "magically" work the second time.
+      subroutine dumdum(r)
+      r = 3.14159
+      end
diff --git a/gcc/f/runtime/libU77/umask_.c b/gcc/f/runtime/libU77/umask_.c
new file mode 100644
index 00000000000..203acfa916f
--- /dev/null
+++ b/gcc/f/runtime/libU77/umask_.c
@@ -0,0 +1,34 @@
+/* Copyright (C) 1996 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include <sys/types.h>
+#include <sys/stat.h>
+#include "f2c.h"
+
+#ifdef KR_headers
+integer G77_umask_0 (mask)
+     integer *mask;
+#else
+integer G77_umask_0 (integer *mask)
+#endif
+{
+  return umask ((mode_t) *mask);
+}
diff --git a/gcc/f/runtime/libU77/unlink_.c b/gcc/f/runtime/libU77/unlink_.c
new file mode 100644
index 00000000000..5e7edf213bc
--- /dev/null
+++ b/gcc/f/runtime/libU77/unlink_.c
@@ -0,0 +1,55 @@
+/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#if HAVE_STDLIB_H
+#  include <stdlib.h>
+#else
+#  include <stdio.h>
+#endif
+#if HAVE_UNISTD_H
+#  include <unistd.h>
+#endif
+#include <errno.h>
+#include <sys/param.h>
+#include "f2c.h"
+
+#ifdef KR_headers
+void g_char ();
+
+integer G77_unlink_0 (str, Lstr)
+     char *str; ftnlen  Lstr;
+#else
+void g_char(const char *a, ftnlen alen, char *b);
+
+integer G77_unlink_0 (const char *str, const ftnlen Lstr)
+#endif
+{
+  char *buff;
+  char *bp, *blast;
+  int i;
+
+  buff = malloc (Lstr+1);
+  if (buff == NULL) return -1;
+  g_char (str, Lstr, buff);
+  i = unlink (buff);
+  free (buff);
+  return i ? errno : 0;		/* SGI version returns -1 on failure. */
+}
diff --git a/gcc/f/runtime/libU77/vxtidate_.c b/gcc/f/runtime/libU77/vxtidate_.c
new file mode 100644
index 00000000000..c517f29419e
--- /dev/null
+++ b/gcc/f/runtime/libU77/vxtidate_.c
@@ -0,0 +1,55 @@
+/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include <stdio.h>
+#if TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+#  include <sys/time.h>
+# else
+#  include <time.h>
+# endif
+#endif
+#include "f2c.h"
+
+/* VMS and Irix versions (at least) differ from libU77 elsewhere */
+
+/* VMS style: */
+
+/* Subroutine */
+#ifdef KR_headers
+int G77_vxtidate_0 (m, d, y)
+     integer *y, *m, *d;
+#else
+int G77_vxtidate_0 (integer *m, integer *d, integer *y)
+#endif
+{
+  struct tm *lt;
+  time_t tim;
+  tim = time(NULL);
+  lt = localtime(&tim);
+  *y = lt->tm_year;
+  *m = lt->tm_mon+1;
+  *d = lt->tm_mday;
+  return 0;
+}
diff --git a/gcc/f/runtime/libU77/vxttime_.c b/gcc/f/runtime/libU77/vxttime_.c
new file mode 100644
index 00000000000..054bb45a89a
--- /dev/null
+++ b/gcc/f/runtime/libU77/vxttime_.c
@@ -0,0 +1,54 @@
+/* Copyright (C) 1995 Free Software Foundation, Inc.
+This file is part of GNU Fortran libU77 library.
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the GNU Library General Public License as published
+by the Free Software Foundation; either version 2 of the License, 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
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with GNU Fortran; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include <stdio.h>
+#if TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+#  include <sys/time.h>
+# else
+#  include <time.h>
+# endif
+#endif
+#if HAVE_STRING_H
+#  include <string.h>
+#else
+#  include <strings.h>
+#endif
+#include "f2c.h"
+
+/* Subroutine */
+#ifdef KR_headers
+void G77_vxttime_0 (chtime, Lchtime)
+     char chtime[8];
+     ftnlen Lchtime;
+#else
+void G77_vxttime_0 (char chtime[8], const ftnlen Lchtime)
+#endif
+{
+  time_t tim;
+  char *ctim;
+  tim = time(NULL);
+  ctim = ctime (&tim);
+  strncpy (chtime, ctim+11, 8);
+}
diff --git a/gcc/f/runtime/permission.netlib b/gcc/f/runtime/permission.netlib
new file mode 100644
index 00000000000..261b719bc57
--- /dev/null
+++ b/gcc/f/runtime/permission.netlib
@@ -0,0 +1,23 @@
+/****************************************************************
+Copyright 1990 - 1997 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
diff --git a/gcc/f/runtime/readme.netlib b/gcc/f/runtime/readme.netlib
new file mode 100644
index 00000000000..22efbfe801e
--- /dev/null
+++ b/gcc/f/runtime/readme.netlib
@@ -0,0 +1,585 @@
+
+====== old index for f2c, now "readme from f2c" ============
+
+FILES:
+
+f2c.h	Include file necessary for compiling output of the converter.
+	See the second NOTE below.
+
+f2c.1	Man page for f2c.
+
+f2c.1t	Source for f2c.1 (to be processed by troff -man or nroff -man).
+
+libf77	Library of non I/O support routines the generated C may need.
+	Fortran main programs result in a C function named MAIN__ that
+	is meant to be invoked by the main() in libf77.
+
+libi77	Library of Fortran I/O routines the generated C may need.
+	Note that some vendors (e.g., BSD, Sun and MIPS) provide a
+	libF77 and libI77 that are incompatible with f2c -- they
+	provide some differently named routines or routines with the
+	names that f2c expects, but with different calling sequences.
+	On such systems, the recommended procedure is to merge
+	libf77 and libi77 into a single library, say libf2c, and to
+        install it where you can access it by specifying -lf2c .  The
+        definition of link_msg in sysdep.c assumes this arrangement.
+
+	Both libf77 and libi77 are bundles, meant to be unpacked by the
+	Bourne (or Korn) shell.  MS-DOS users can use the MKS Toolkit
+	to unpack libf77 and libi77.
+
+libf2c.zip
+	Only available by ftp: combination of libf77 and libi77, with
+	Unix and PC makefiles.
+
+f2c.ps	Postscript for a technical report on f2c.  After you strip the
+	mail header, the first line should be "%!PS".
+
+fixes	The complete change log, reporting bug fixes and other changes.
+	(Some recent change-log entries are given below).
+
+fc	A shell script that uses f2c and imitates much of the behavior
+	of commonly found f77 commands.  You will almost certainly
+	need to adjust some of the shell-variable assignments to make
+	this script work on your system.
+
+
+SUBDIRECTORY:
+
+f2c/src	Source for the converter itself, including a file of checksums
+	and source for a program to compute the checksums (to verify
+	correct transmission of the source), is available: ask netlib
+	(e.g., netlib@netlib.bell-labs.com) to
+		send all from f2c/src
+	If the checksums show damage to just a few source files, or if
+	the change log file (see "fixes" below) reports corrections to
+	some source files, you can request those files individually
+	"from f2c/src".  For example, to get defs.h and xsum0.out, you
+	would ask netlib to
+		send defs.h xsum0.out from f2c/src
+	"all from f2c/src" is about 640 kilobytes long; for convenience
+	(and checksums), it includes copies of f2c.h, f2c.1, and f2c.1t.
+
+	Tip: if asked to send over 99,000 bytes in one request, netlib
+	breaks the shipment into 1000 line pieces and sends each piece
+	separately (since otherwise some mailers might gag).  To avoid
+	the hassle of reassembling the pieces, try to keep each request
+	under 99,000 bytes long.  The final number in each line of
+	xsum0.out gives the length of each file in f2c/src.  For
+	example,
+		send exec.c expr.c from f2c/src
+		send format.c format_data.c from f2c/src
+	will give you slightly less hassle than
+		send exec.c expr.c format.c format_data.c from f2c/src
+	Alternatively, if all the mailers in your return path allow
+	long messages, you can supply an appropriate mailsize line in
+	your netlib request, e.g.
+		mailsize 200k
+		send exec.c expr.c format.c format_data.c from f2c/src
+
+	If you have trouble generating gram.c, you can ask netlib to
+		send gram.c from f2c/src
+	Then `xsum gram.c` should report
+		gram.c	5529f4f	58745
+	Alternatively, if you have bison, you might get a working
+	gram.c by saying
+		make gram.c YACC=bison YFLAGS=-y
+	(but please do not complain if this gives a bad gram.c).
+
+NOTE:	For now, you may exercise f2c by sending netlib a message whose
+	first line is "execute f2c" and whose remaining lines are
+	the Fortran 77 source that you wish to have converted.
+	Return mail brings you the resulting C, with f2c's error
+	messages between #ifdef uNdEfInEd and #endif at the end.
+	(To understand line numbers in the error messages, regard
+	the "execute f2c" line as line 0.  It is stripped away by
+	the netlib software before f2c sees your Fortran input.)
+	Options described in the man page may be transmitted to
+	netlib by having the first line of input be a comment
+	whose first 6 characters are "c$f2c " and whose remaining
+	characters are the desired options, e.g., "c$f2c -R -u".
+
+	You may say "execute f2c" in the Subject line instead of (but
+	*not* in addition to) in the first line of the message body.
+
+	The incoming Fortran is saved, at least for a while.  Don't
+	send any secrets!
+
+
+BUGS:	Please send bug reports (including the shortest example
+	you can find that illustrates the bug) to research!dmg
+	or dmg@bell-labs.com .  You might first check whether
+	the bug goes away when you turn optimization off.
+
+
+NOTE:	f2c.h defines several types, e.g., real, integer, doublereal.
+	The definitions in f2c.h are suitable for most machines, but if
+	your machine has sizeof(double) > 2*sizeof(long), you may need
+	to adjust f2c.h appropriately.  f2c assumes
+		sizeof(doublecomplex) = 2*sizeof(doublereal)
+		sizeof(doublereal) = sizeof(complex)
+		sizeof(doublereal) = 2*sizeof(real)
+		sizeof(real) = sizeof(integer)
+		sizeof(real) = sizeof(logical)
+		sizeof(real) = 2*sizeof(shortint)
+	EQUIVALENCEs may not be translated correctly if these
+	assumptions are violated.
+
+	On machines, such as those using a DEC Alpha processor, on
+	which sizeof(short) == 2, sizeof(int) == sizeof(float) == 4,
+	and sizeof(long) == sizeof(double) == 8, it suffices to
+	modify f2c.h by removing the first occurrence of "long "
+	on each line containing "long ", e.g., by issuing the
+	commands
+		mv f2c.h f2c.h0
+		sed 's/long //' f2c.h0 >f2c.h
+	On such machines, one can enable INTEGER*8 by uncommenting
+	the typedef of longint in f2c.h, so it reads
+		typedef long longint;
+	by compiling libI77 with -DAllow_TYQUAD, and by adjusting
+	libF77/makefile as described in libF77/README.
+
+	Some machines may have sizeof(int) == 4 and
+	sizeof(long long) == 8.  On such machines, adjust f2c.h
+	by changing "long int " to "long long ", e.g., by saying
+		mv f2c.h f2c.h0
+		sed 's/long int /long long /' f2c.h0 >f2c.h
+	One can enable INTEGER*8 on such machines as described
+	above, but with
+		typedef long long longint;
+
+	There exists a C compiler that objects to the lines
+		typedef VOID C_f;	/* complex function */
+		typedef VOID H_f;	/* character function */
+		typedef VOID Z_f;	/* double complex function */
+	in f2c.h .  If yours is such a compiler, do two things:
+	1. Complain to your vendor about this compiler bug.
+	2. Find the line
+		#define VOID void
+	   in f2c.h and change it to
+		#define VOID int
+	(For readability, the f2c.h lines shown above have had two
+	tabs inserted before their first character.)
+
+FTP:	All the material described above is now available by anonymous
+	ftp from netlib.bell-labs.com (login: anonymous; Password: your
+	E-mail address; cd netlib/f2c).  Note that you can say, e.g.,
+
+		cd /netlib/f2c/src
+		binary
+		prompt
+		mget *.Z
+
+	to get all the .Z files in src.  You must uncompress the .Z
+	files once you have a copy of them, e.g., by
+
+		uncompress *.Z
+
+	Subdirectory msdos contains two PC versions of f2c,
+	f2c.exe.Z and f2cx.exe.Z; the latter uses extended memory.
+	The README in that directory provides more details.
+
+	Changes appear first in the f2c files available by E-mail
+	from netlib@netlib.bell-labs.com.  If the deamons work right,
+	changed files are available the next day by ftp from
+	netlib.bell-labs.com.  In due course, they reach other netlib servers.
+
+CHANGE NOTIFICATION:
+	Send the E-mail message
+		subscribe f2c
+	to netlib@netlib.bell-labs.com to request notification of new and
+	changed f2c files.  (Beware that automatically sent change
+	notifications may reach you before changes have reached
+	ftp://netlib.bell-labs.com/netlib/f2c or to other netlib servers.)
+	Send the E-mail message
+		unsubscribe f2c
+	to recant your notification request.
+
+-----------------
+Recent change log (partial)
+-----------------
+
+Mon May 13 23:35:26 EDT 1996
+  Recognize Fortran 90's /= as a synonym for .NE..  (<> remains a
+synonym for .NE..)
+  Emit an empty int function of no arguments to supply an external
+name to named block data subprograms (so they can be called somewhere
+to force them to be loaded from a library).
+  Fix bug (memory fault) in handling the following illegal Fortran:
+	parameter(i=1)
+	equivalence(i,j)
+	end
+  Treat cdabs, cdcos, cdexp, cdlog, cdsin, and cdsqrt as synonyms for
+the double complex intrinsics zabs, zcos, zexp, zlog, zsin, and zsqrt,
+respectively, unless -cd is specified.
+  Recognize the Fortran 90 bit-manipulation intrinsics btest, iand,
+ibclr, ibits, ibset, ieor, ior, ishft, and ishftc, unless -i90 is
+specified.  Note that iand, ieor, and ior are thus now synonyms for
+"and", "xor", and "or", respectively.
+  Add three macros (bit_test, bit_clear, bit_set) to f2c.h for use
+with btest, ibclr, and ibset, respectively.  Add new functions
+[lq]bit_bits, [lq]bit_shift, and [lq]_bit_cshift to libF77 for
+use with ibits, ishft, and ishftc, respectively.
+  Add integer function ftell(unit) (returning -1 on error) and
+subroutine fseek(unit, offset, whence, *) to libI77 (with branch to
+label * on error).
+
+Tue May 14 23:21:12 EDT 1996
+  Fix glitch (possible memory fault, or worse) in handling multiple
+entry points with names over 28 characters long.
+
+Mon Jun 10 01:20:16 EDT 1996
+  Update netlib E-mail and ftp addresses in f2c/readme and
+f2c/src/readme (which are different files) -- to reflect the upcoming
+breakup of AT&T.
+  libf77: trivial tweaks to F77_aloc.c and system_.c; Version.c not
+changed.
+  libi77: Adjust rsli.c and lread.c so internal list input with too
+few items in the input string will honor end= .
+
+Mon Jun 10 22:59:57 EDT 1996
+  Add Bits_per_Byte to sysdep.h and adjust definition of Table_size
+to depend on Bits_per_Byte (forcing Table_size to be a power of 2); in
+lex.c, change "comstart[c & 0xfff]" to "comstart[c & (Table_size-1)]"
+to avoid an out-of-range subscript on end-of-file.
+
+Wed Jun 12 00:24:28 EDT 1996
+  Fix bug in output.c (dereferencing a freed pointer) revealed in
+	print *		!np in out_call in output.c clobbered by free
+	end		!during out_expr.
+
+Wed Jun 19 08:12:47 EDT 1996
+  f2c.h: add types uinteger, ulongint (for libF77); add qbit_clear
+and qbit_set macros (in a commented-out section) for integer*8.
+  For integer*8, use qbit_clear and qbit_set for ibclr and ibset.
+  libf77: add casts to unsigned in [lq]bitshft.c.
+
+Thu Jun 20 13:30:43 EDT 1996
+  Complain at character*(*) in common (rather than faulting).
+  Fix bug in recognizing hex constants that start with "16#" (e.g.,
+16#1234abcd, which is a synonym for z'1234abcd').
+  Fix bugs in constant folding of expressions involving btest, ibclr,
+and ibset.
+  Fix bug in constant folding of rshift(16#80000000, -31) (on a 32-bit
+machine; more generally, the bug was in constant folding of
+rshift(ibset(0,NBITS-1), 1-NBITS) when f2c runs on a machine with
+long ints having NBITS bits.
+
+Mon Jun 24 07:58:53 EDT 1996
+  Adjust struct Literal and newlabel() function to accommodate huge
+source files (with more than 32767 newlabel() invocations).
+  Omit .c file when the .f file has a missing final end statement.
+
+Wed Jun 26 14:00:02 EDT 1996
+  libi77: Add discussion of MXUNIT (highest allowed Fortran unit number)
+to libI77/README.
+
+Fri Jun 28 14:16:11 EDT 1996
+  Fix glitch with -onetrip: the temporary variable used for nonconstant
+initial loop variable values was recycled too soon.  Example:
+	do i = j+1, k
+		call foo(i+1)	! temp for j+1 was reused here
+		enddo
+	end
+
+Tue Jul  2 16:11:27 EDT 1996
+  formatdata.c: add a 0 to the end of the basetype array (for TYBLANK)
+(an omission that was harmless on most machines).
+  expr.c: fix a dereference of NULL that was only possible with buggy
+input, such as
+	subroutine $sub(s)	! the '$' is erroneous
+	character s*(*)
+	s(1:) = ' '
+	end
+
+Sat Jul  6 00:44:56 EDT 1996
+  Fix glitch in the intrinsic "real" function when applied to a
+complex (or double complex) variable and passed as an argument to
+some intrinsic functions.  Example:
+	complex a
+	b = sqrt(real(a))
+	end
+  Fix glitch (only visible if you do not use f2c's malloc and the
+malloc you do use is defective in the sense that malloc(0) returns 0)
+in handling include files that end with another include (perhaps
+followed by comments).
+  Fix glitch with character*(*) arguments named "h" and "i" when
+the body of the subroutine invokes the intrinsic LEN function.
+  Arrange that after a previous "f2c -P foo.f" has produced foo.P,
+running "f2c foo.P foo.f" will produce valid C when foo.f contains
+	call sub('1234')
+	end
+	subroutine sub(msg)
+	end
+Specifically, the length argument in "call sub" is now suppressed.
+With or without foo.P, it is also now suppressed when the order of
+subprograms in file foo.f is reversed:
+	subroutine sub(msg)
+	end
+	call sub('1234')
+	end
+  Adjust copyright notices to reflect AT&T breakup.
+
+Wed Jul 10 09:25:49 EDT 1996
+  Fix bug (possible memory fault) in handling erroneously placed
+and inconsistent declarations.  Example that faulted:
+	character*1 w(8)
+	call foo(w)
+	end
+	subroutine foo(m)
+	data h /0.5/
+	integer m(2)	! should be before data
+	end
+  Fix bug (possible fault) in handling illegal "if" constructions.
+Example (that faulted):
+	subroutine foo(i,j)
+	if (i) then		! bug: i is integer, not logical
+	else if (j) then	! bug: j is integer, not logical
+	endif
+	end
+  Fix glitch with character*(*) argument named "ret_len" to a
+character*(*) function.
+
+Wed Jul 10 23:04:16 EDT 1996
+  Fix more glitches in the intrinsic "real" function when applied to a
+complex (or double complex) variable and passed as an argument to
+some intrinsic functions.  Example:
+	complex a, b
+	r = sqrt(real(conjg(a))) + sqrt(real(a*b))
+	end
+
+Thu Jul 11 17:27:16 EDT 1996
+  Fix a memory fault associated with complicated, illegal input.
+Example:
+	subroutine goo
+	character a
+	call foo(a)	! inconsistent with subsequent def and call
+	end
+	subroutine foo(a)
+	end
+	call foo(a)
+	end
+
+Wed Jul 17 19:18:28 EDT 1996
+  Fix yet another case of intrinsic "real" applied to a complex
+argument.  Example:
+	complex a(3)
+	x = sqrt(real(a(2)))	! gave error message about bad tag
+	end
+
+Mon Aug 26 11:28:57 EDT 1996
+  Tweak sysdep.c for non-Unix systems in which process ID's can be
+over 5 digits long.
+
+Tue Aug 27 08:31:32 EDT 1996
+  Adjust the ishft intrinsic to use unsigned right shifts.  (Previously,
+a negative constant second operand resulted in a possibly signed shift.)
+
+Thu Sep 12 14:04:07 EDT 1996
+  equiv.c: fix glitch with -DKR_headers.
+  libi77: fmtlib.c: fix bug in printing the most negative integer.
+
+Fri Sep 13 08:54:40 EDT 1996
+  Diagnose some illegal appearances of substring notation.
+
+Tue Sep 17 17:48:09 EDT 1996
+  Fix fault in handling some complex parameters.  Example:
+	subroutine foo(a)
+	double complex a, b
+	parameter(b = (0,1))
+	a = b	! f2c faulted here
+	end
+
+Thu Sep 26 07:47:10 EDT 1996
+  libi77:  fmt.h:  for formatted writes of negative integer*1 values,
+make ic signed on ANSI systems.  If formatted writes of integer*1
+values trouble you when using a K&R C compiler, switch to an ANSI
+compiler or use a compiler flag that makes characters signed.
+
+Tue Oct  1 14:41:36 EDT 1996
+  Give a better error message when dummy arguments appear in data
+statements.
+
+Thu Oct 17 13:37:22 EDT 1996
+  Fix bug in typechecking arguments to character and complex (or
+double complex) functions; the bug could cause length arguments
+for character arguments to be omitted on invocations appearing
+textually after the first invocation.  For example, in
+	subroutine foo
+	character c
+	complex zot
+	call goo(zot(c), zot(c))
+	end
+the length was omitted from the second invocation of zot, and
+there was an erroneous error message about inconsistent calling
+sequences.
+
+Wed Dec  4 13:59:14 EST 1996
+  Fix bug revealed by
+	subroutine test(cdum,rdum)
+	complex cdum
+	rdum=cos(real(cdum))	! "Unexpected tag 3 in opconv_fudge"
+	end
+  Fix glitch in parsing "DO 10 D0 = 1, 10".
+  Fix glitch in parsing
+	real*8 x
+	real*8 x	! erroneous "incompatible type" message
+	call foo(x)
+	end
+  lib[FI]77/makefile: add comment about omitting -x under Solaris.
+
+Mon Dec  9 23:15:02 EST 1996
+  Fix glitch in parameter adjustments for arrays whose lower
+bound depends on a scalar argument.  Example:
+	subroutine bug(p,z,m,n)
+	integer z(*),m,n
+	double precision p(z(m):z(m) + n)	! p_offset botched
+	call foo(p(0), p(n))
+	end
+  libi77: complain about non-positive rec= in direct read and write
+statements.
+  libf77: trivial adjustments; Version.c not changed.
+
+Wed Feb 12 00:18:03 EST 1997
+  output.c: fix (seldom problematic) glitch in out_call: put parens
+around the ... in a test of the form "if (q->tag == TADDR && ...)".
+  vax.c: fix bug revealed in the "psi_offset =" assignment in the
+following example:
+	subroutine foo(psi,m)
+	integer z(100),m
+	common /a/ z
+	double precision psi(z(m):z(m) + 10)
+	call foo(m+1, psi(0),psi(10))
+	end
+
+Mon Feb 24 23:44:54 EST 1997
+  For consistency with f2c's current treatment of adjacent character
+strings in FORMAT statements, recognize a Hollerith string following
+a string (and merge adjacent strings in FORMAT statements).
+
+Wed Feb 26 13:41:11 EST 1997
+  New libf2c.zip, a combination of the libf77 and libi77 bundles (and
+available only by ftp).
+  libf77: adjust functions with a complex output argument to permit
+aliasing it with input arguments.  (For now, at least, this is just
+for possible benefit of g77.)
+  libi77: tweak to ftell_.c for systems with strange definitions of
+SEEK_SET, etc.
+
+Tue Apr  8 20:57:08 EDT 1997
+  libf77: [cz]_div.c: tweaks invisible on most systems (that may
+improve things slightly with optimized compilation on systems that use
+gratuitous extra precision).
+  libi77: fmt.c: adjust to complain at missing numbers in formats
+(but still treat missing ".nnn" as ".0").
+
+Fri Apr 11 14:05:57 EDT 1997
+  libi77: err.c: attempt to make stderr line buffered rather than
+fully buffered.  (Buffering is needed for format items T and TR.)
+
+Thu Apr 17 22:42:43 EDT 1997
+ libf77: add F77_aloc.o to makefile (and makefile.u in libf2c.zip).
+
+Fri Apr 25 19:32:09 EDT 1997
+ libf77: add [de]time_.c (which may give trouble on some systems).
+
+Tue May 27 09:18:52 EDT 1997
+ libi77: ftell_.c: fix typo that caused the third argument to be
+treated as 2 on some systems.
+
+Mon Jun  9 00:04:37 EDT 1997
+ libi77 (and libf2c.zip): adjust include order in err.c lread.c wref.c
+rdfmt.c to include fmt.h (etc.) after system includes.  Version.c not
+changed.
+
+Mon Jun  9 14:29:13 EDT 1997
+ src/gram.c updated; somehow it did not reflect the change of
+19961001 to gram.dcl.
+
+Mon Jul 21 16:04:54 EDT 1997
+  proc.c: fix glitch in logic for "nonpositive dimension" message.
+  libi77: inquire.c: always include string.h (for possible use with
+-DNON_UNIX_STDIO); Version.c not changed.
+
+Thu Jul 24 17:11:23 EDT 1997
+  Tweak "Notice" to reflect the AT&T breakup -- we missed it when
+updating the copyright notices in the source files last summer.
+  Adjust src/makefile so malloc.o is not used by default, but can
+be specified with "make MALLOC=malloc.o".
+  Add comments to src/README about the "CRAY" T3E.
+
+Tue Aug  5 14:53:25 EDT 1997
+  Add definition of calloc to malloc.c; this makes f2c's malloc
+work on some systems where trouble hitherto arose because references
+to calloc brought in the system's malloc.  (On sensible systems,
+calloc is defined separately from malloc.  To avoid confusion on
+other systems, f2c/malloc.c now defines calloc.)
+  libi77: lread.c: adjust to accord with a change to the Fortran 8X
+draft (in 1990 or 1991) that rescinded permission to elide quote marks
+in namelist input of character data; to get the old behavior, compile
+with F8X_NML_ELIDE_QUOTES #defined.  wrtfmt.o: wrt_G: tweak to print
+the right number of 0's for zero under G format.
+
+Current timestamps of files in "all from f2c/src", sorted by time,
+appear below (mm/dd/year hh:mm:ss).  To bring your source up to date,
+obtain source files with a timestamp later than the time shown in your
+version.c.  Note that the time shown in the current version.c is the
+timestamp of the source module that immediately follows version.c below:
+
+ 8/05/1997  14:51:56  xsum0.out
+ 8/05/1997  14:42:48  version.c
+ 8/05/1997  10:31:26  malloc.c
+ 7/24/1997  17:10:55  README
+ 7/24/1997  17:00:57  makefile
+ 7/24/1997  16:06:19  Notice
+ 7/21/1997  12:58:44  proc.c
+ 2/19/1997  13:34:09  lex.c
+ 2/11/1997  23:39:14  vax.c
+12/22/1996  11:51:22  output.c
+12/04/1996  13:07:53  gram.exec
+10/17/1996  13:10:40  putpcc.c
+10/01/1996  14:36:18  gram.dcl
+10/01/1996  14:36:18  init.c
+10/01/1996  14:36:18  defs.h
+10/01/1996  14:36:17  data.c
+ 9/17/1996  17:29:44  expr.c
+ 9/12/1996  12:12:46  equiv.c
+ 8/27/1996   8:30:32  intr.c
+ 8/26/1996   9:41:13  sysdep.c
+ 7/09/1996  10:41:13  format.c
+ 7/09/1996  10:40:45  names.c
+ 7/04/1996   9:58:31  formatdata.c
+ 7/04/1996   9:55:45  sysdep.h
+ 7/04/1996   9:55:43  put.c
+ 7/04/1996   9:55:41  pread.c
+ 7/04/1996   9:55:40  parse_args.c
+ 7/04/1996   9:55:40  p1output.c
+ 7/04/1996   9:55:38  niceprintf.c
+ 7/04/1996   9:55:37  misc.c
+ 7/04/1996   9:55:36  memset.c
+ 7/04/1996   9:55:36  mem.c
+ 7/04/1996   9:55:35  main.c
+ 7/04/1996   9:55:33  io.c
+ 7/04/1996   9:55:30  exec.c
+ 7/04/1996   9:55:29  error.c
+ 7/04/1996   9:55:27  cds.c
+ 7/03/1996  15:47:49  xsum.c
+ 6/19/1996   7:04:27  f2c.h
+ 6/19/1996   2:52:05  defines.h
+ 5/13/1996   0:40:32  gram.head
+ 5/12/1996  23:37:11  f2c.1
+ 5/12/1996  23:37:02  f2c.1t
+ 2/25/1994   2:07:19  parse.h
+ 2/22/1994  19:07:20  iob.h
+ 2/22/1994  18:56:53  p1defs.h
+ 2/22/1994  18:53:46  output.h
+ 2/22/1994  18:51:14  names.h
+ 2/22/1994  18:30:41  format.h
+ 1/18/1994  18:12:52  tokens
+ 3/06/1993  14:13:58  gram.expr
+ 1/28/1993   9:03:16  ftypes.h
+ 4/06/1990   0:00:57  gram.io
+ 2/03/1990   0:58:26  niceprintf.h
+ 1/07/1990   1:20:01  usignal.h
+11/27/1989   8:27:37  machdefs.h
+ 7/01/1989  11:59:44  pccdefs.h
diff --git a/gcc/f/src.c b/gcc/f/src.c
new file mode 100644
index 00000000000..095c0481af9
--- /dev/null
+++ b/gcc/f/src.c
@@ -0,0 +1,436 @@
+/* src.c -- Implementation File
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 <ctype.h>
+#include "src.h"
+#include "top.h"
+
+/* This array does a toupper (), but any valid char type is valid as an
+   index and returns identity if not a lower-case character.  */
+
+char ffesrc_toupper_[256];
+
+/* This array does a tolower (), but any valid char type is valid as an
+   index and returns identity if not an upper-case character.  */
+
+char ffesrc_tolower_[256];
+
+/* 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 ()
+{
+  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_toupper_[i] = i;
+      ffesrc_tolower_[i] = i;
+      ffesrc_bad_symbol_init_[i] = FFEBAD;
+      ffesrc_bad_symbol_noninit_[i] = FFEBAD;
+    }
+
+  for (i = 'A'; i <= 'Z'; ++i)
+    ffesrc_tolower_[i] = tolower (i);
+
+  for (i = 'a'; i <= 'z'; ++i)
+    ffesrc_toupper_[i] = toupper (i);
+
+  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 = ffesrc_toupper (c);	/* Upcase source. */
+	  d = ffesrc_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 = ffesrc_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 = ffesrc_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 = ffesrc_toupper (c);
+	      d = ffesrc_toupper (d);
+	      while ((len > 0) && (c == d))
+		{		/* Skip past equivalent (case-ins) chars. */
+		  --len, ++var, ++str_ic;
+		  if (len > 0)
+		    c = ffesrc_toupper (*var);
+		  d = ffesrc_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 = ffesrc_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 = ffesrc_toupper (*var);
+	      while ((c != '\0') && (c == *str_uc))
+		{		/* Skip past equivalent (case-ins) chars. */
+		  ++var, ++str_uc;
+		  c = ffesrc_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 = ffesrc_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 = ffesrc_toupper (*var);
+	      while ((len > 0) && (c == *str_uc))
+		{		/* Skip past equivalent (case-ins) chars. */
+		  --len, ++var, ++str_uc;
+		  if (len > 0)
+		    c = ffesrc_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
new file mode 100644
index 00000000000..02279154d28
--- /dev/null
+++ b/gcc/f/src.h
@@ -0,0 +1,144 @@
+/* src.h -- Public #include File
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_src
+#define _H_f_src
+
+#include "bad.h"
+#include "top.h"
+
+extern char ffesrc_toupper_[256];
+extern char ffesrc_tolower_[256];
+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()
+#define ffesrc_toupper(c) (ffesrc_toupper_[(unsigned int) (c)])
+#define ffesrc_tolower(c) (ffesrc_tolower_[(unsigned int) (c)])
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/st.c b/gcc/f/st.c
new file mode 100644
index 00000000000..5406acdb5a7
--- /dev/null
+++ b/gcc/f/st.c
@@ -0,0 +1,554 @@
+/* st.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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
new file mode 100644
index 00000000000..d762f6c9253
--- /dev/null
+++ b/gcc/f/st.h
@@ -0,0 +1,81 @@
+/* st.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_st
+#define _H_f_st
+
+/* 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
diff --git a/gcc/f/sta.c b/gcc/f/sta.c
new file mode 100644
index 00000000000..328bfd0f662
--- /dev/null
+++ b/gcc/f/sta.c
@@ -0,0 +1,1993 @@
+/* sta.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995-1997 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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_ ()
+{
+  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_ ()
+{
+  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
+	= (ffelexToken *) malloc_new_ksr (malloc_pool_image (),
+					  "FFEST Saved Tokens",
+			     (max_saved_tokens = 8) * sizeof (ffelexToken));
+      /* Start off with 8. */
+    }
+  else if (num_saved_tokens >= max_saved_tokens)
+    {
+      toknum = max_saved_tokens;
+      max_saved_tokens <<= 1;	/* Multiply by two. */
+      assert (max_saved_tokens > toknum);
+      saved_tokens
+	= (ffelexToken *) malloc_resize_ksr (malloc_pool_image (),
+					     saved_tokens,
+				    max_saved_tokens * sizeof (ffelexToken),
+					     toknum * sizeof (ffelexToken));
+    }
+
+  *(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_)
+	{
+	  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_)
+			{
+			  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)
+    {
+#if FFESTR_VXT
+    case FFESTR_firstACCEPT:
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_V019);
+      break;
+#endif
+
+#if FFESTR_F90
+    case FFESTR_firstALLOCATABLE:
+      ffestb_args.dimlist.len = FFESTR_firstlALLOCATABLE;
+      ffestb_args.dimlist.badname = "ALLOCATABLE";
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_dimlist);
+      break;
+#endif
+
+#if FFESTR_F90
+    case FFESTR_firstALLOCATE:
+      ffestb_args.heap.len = FFESTR_firstlALLOCATE;
+      ffestb_args.heap.badname = "ALLOCATE";
+      ffestb_args.heap.ctx = FFEEXPR_contextALLOCATE;
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_heap);
+      break;
+#endif
+
+    case FFESTR_firstASSIGN:
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R838);
+      break;
+
+    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:
+      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;
+
+#if FFESTR_F90
+    case FFESTR_firstCONTAINS:
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R1228);
+      break;
+#endif
+
+    case FFESTR_firstCONTINUE:
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R841);
+      break;
+
+    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;
+
+#if FFESTR_F90
+    case FFESTR_firstDEALLOCATE:
+      ffestb_args.heap.len = FFESTR_firstlDEALLOCATE;
+      ffestb_args.heap.badname = "DEALLOCATE";
+      ffestb_args.heap.ctx = FFEEXPR_contextDEALLOCATE;
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_heap);
+      break;
+#endif
+
+#if FFESTR_VXT
+    case FFESTR_firstDECODE:
+      ffestb_args.vxtcode.len = FFESTR_firstlDECODE;
+      ffestb_args.vxtcode.badname = "DECODE";
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_vxtcode);
+      break;
+#endif
+
+#if FFESTR_VXT
+    case FFESTR_firstDEFINEFILE:
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_V025);
+      break;
+
+    case FFESTR_firstDELETE:
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_V021);
+      break;
+#endif
+    case FFESTR_firstDIMENSION:
+      ffestb_args.R524.len = FFESTR_firstlDIMENSION;
+      ffestb_args.R524.badname = "DIMENSION";
+      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;
+
+#if FFESTR_F90
+    case FFESTR_firstELSEWHERE:
+      ffestb_args.elsexyz.second = FFESTR_secondWHERE;
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_elsexyz);
+      break;
+#endif
+
+#if FFESTR_VXT
+    case FFESTR_firstENCODE:
+      ffestb_args.vxtcode.len = FFESTR_firstlENCODE;
+      ffestb_args.vxtcode.badname = "ENCODE";
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_vxtcode);
+      break;
+#endif
+
+    case FFESTR_firstEND:
+      if ((ffelex_token_type (ffesta_token_0_) == FFELEX_typeNAMES)
+	  || (ffelex_token_type (t) != FFELEX_typeNAME))
+	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:
+#if FFESTR_F90
+	    case FFESTR_secondMODULE:
+#endif
+	    case FFESTR_secondPROGRAM:
+	    case FFESTR_secondSELECT:
+	    case FFESTR_secondSUBROUTINE:
+#if FFESTR_F90
+	    case FFESTR_secondWHERE:
+#endif
+	      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_end);
+	      break;
+
+	    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;
+
+#if FFESTR_F90
+    case FFESTR_firstENDINTERFACE:
+      ffestb_args.endxyz.len = FFESTR_firstlENDINTERFACE;
+      ffestb_args.endxyz.second = FFESTR_secondINTERFACE;
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_endxyz);
+      break;
+#endif
+
+#if FFESTR_VXT
+    case FFESTR_firstENDMAP:
+      ffestb_args.endxyz.len = FFESTR_firstlENDMAP;
+      ffestb_args.endxyz.second = FFESTR_secondMAP;
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_endxyz);
+      break;
+#endif
+
+#if FFESTR_F90
+    case FFESTR_firstENDMODULE:
+      ffestb_args.endxyz.len = FFESTR_firstlENDMODULE;
+      ffestb_args.endxyz.second = FFESTR_secondMODULE;
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz);
+      break;
+#endif
+
+    case FFESTR_firstENDPROGRAM:
+      ffestb_args.endxyz.len = FFESTR_firstlENDPROGRAM;
+      ffestb_args.endxyz.second = FFESTR_secondPROGRAM;
+      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;
+
+#if FFESTR_VXT
+    case FFESTR_firstENDSTRUCTURE:
+      ffestb_args.endxyz.len = FFESTR_firstlENDSTRUCTURE;
+      ffestb_args.endxyz.second = FFESTR_secondSTRUCTURE;
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_endxyz);
+      break;
+#endif
+
+    case FFESTR_firstENDSUBROUTINE:
+      ffestb_args.endxyz.len = FFESTR_firstlENDSUBROUTINE;
+      ffestb_args.endxyz.second = FFESTR_secondSUBROUTINE;
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz);
+      break;
+
+#if FFESTR_F90
+    case FFESTR_firstENDTYPE:
+      ffestb_args.endxyz.len = FFESTR_firstlENDTYPE;
+      ffestb_args.endxyz.second = FFESTR_secondTYPE;
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_endxyz);
+      break;
+#endif
+
+#if FFESTR_VXT
+    case FFESTR_firstENDUNION:
+      ffestb_args.endxyz.len = FFESTR_firstlENDUNION;
+      ffestb_args.endxyz.second = FFESTR_secondUNION;
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_endxyz);
+      break;
+#endif
+
+#if FFESTR_F90
+    case FFESTR_firstENDWHERE:
+      ffestb_args.endxyz.len = FFESTR_firstlENDWHERE;
+      ffestb_args.endxyz.second = FFESTR_secondWHERE;
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz);
+      break;
+#endif
+
+    case FFESTR_firstENTRY:
+      ffestb_args.dummy.len = FFESTR_firstlENTRY;
+      ffestb_args.dummy.badname = "ENTRY";
+      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;
+
+#if FFESTR_VXT
+    case FFESTR_firstFIND:
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_V026);
+      break;
+#endif
+
+      /* WARNING: don't put anything that might cause an item to precede
+	 FORMAT in the list of possible statements (it's added below) without
+	 making sure FORMAT still is first.  It has to run with
+	 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_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;
+
+#if FFESTR_F90
+    case FFESTR_firstINTENT:
+      ffestb_args.varlist.len = FFESTR_firstlINTENT;
+      ffestb_args.varlist.badname = "INTENT";
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_varlist);
+      break;
+#endif
+
+#if FFESTR_F90
+    case FFESTR_firstINTERFACE:
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R1202);
+      break;
+#endif
+
+    case FFESTR_firstINTRINSIC:
+      ffestb_args.varlist.len = FFESTR_firstlINTRINSIC;
+      ffestb_args.varlist.badname = "INTRINSIC";
+      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;
+
+#if FFESTR_VXT
+    case FFESTR_firstMAP:
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_V012);
+      break;
+#endif
+
+#if FFESTR_F90
+    case FFESTR_firstMODULE:
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_module);
+      break;
+#endif
+
+    case FFESTR_firstNAMELIST:
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R542);
+      break;
+
+#if FFESTR_F90
+    case FFESTR_firstNULLIFY:
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R624);
+      break;
+#endif
+
+    case FFESTR_firstOPEN:
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R904);
+      break;
+
+#if FFESTR_F90
+    case FFESTR_firstOPTIONAL:
+      ffestb_args.varlist.len = FFESTR_firstlOPTIONAL;
+      ffestb_args.varlist.badname = "OPTIONAL";
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_varlist);
+      break;
+#endif
+
+    case FFESTR_firstPARAMETER:
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R537);
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_V027);
+      break;
+
+    case FFESTR_firstPAUSE:
+      ffestb_args.halt.len = FFESTR_firstlPAUSE;
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_halt);
+      break;
+
+#if FFESTR_F90
+    case FFESTR_firstPOINTER:
+      ffestb_args.dimlist.len = FFESTR_firstlPOINTER;
+      ffestb_args.dimlist.badname = "POINTER";
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_dimlist);
+      break;
+#endif
+
+    case FFESTR_firstPRINT:
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R911);
+      break;
+
+#if HARD_F90
+    case FFESTR_firstPRIVATE:
+      ffestb_args.varlist.len = FFESTR_firstlPRIVATE;
+      ffestb_args.varlist.badname = "ACCESS";
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_varlist);
+      break;
+#endif
+
+    case FFESTR_firstPROGRAM:
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R1102);
+      break;
+
+#if HARD_F90
+    case FFESTR_firstPUBLIC:
+      ffestb_args.varlist.len = FFESTR_firstlPUBLIC;
+      ffestb_args.varlist.badname = "ACCESS";
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_varlist);
+      break;
+#endif
+
+    case FFESTR_firstREAD:
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R909);
+      break;
+
+    case FFESTR_firstREAL:
+      ffestb_args.decl.len = FFESTR_firstlREAL;
+      ffestb_args.decl.type = FFESTP_typeREAL;
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_gentype);
+      break;
+
+#if FFESTR_VXT
+    case FFESTR_firstRECORD:
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_V016);
+      break;
+#endif
+
+#if FFESTR_F90
+    case FFESTR_firstRECURSIVE:
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_recursive);
+      break;
+#endif
+
+    case FFESTR_firstRETURN:
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R1227);
+      break;
+
+    case FFESTR_firstREWIND:
+      ffestb_args.beru.len = FFESTR_firstlREWIND;
+      ffestb_args.beru.badname = "REWIND";
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_beru);
+      break;
+
+#if FFESTR_VXT
+    case FFESTR_firstREWRITE:
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_V018);
+      break;
+#endif
+
+    case FFESTR_firstSAVE:
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R522);
+      break;
+
+    case FFESTR_firstSELECT:
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R809);
+      break;
+
+    case FFESTR_firstSELECTCASE:
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R809);
+      break;
+
+#if HARD_F90
+    case FFESTR_firstSEQUENCE:
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R423B);
+      break;
+#endif
+
+    case FFESTR_firstSTOP:
+      ffestb_args.halt.len = FFESTR_firstlSTOP;
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_halt);
+      break;
+
+#if FFESTR_VXT
+    case FFESTR_firstSTRUCTURE:
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_V003);
+      break;
+#endif
+
+    case FFESTR_firstSUBROUTINE:
+      ffestb_args.dummy.len = FFESTR_firstlSUBROUTINE;
+      ffestb_args.dummy.badname = "SUBROUTINE";
+      ffestb_args.dummy.is_subr = TRUE;
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_dummy);
+      break;
+
+#if FFESTR_F90
+    case FFESTR_firstTARGET:
+      ffestb_args.dimlist.len = FFESTR_firstlTARGET;
+      ffestb_args.dimlist.badname = "TARGET";
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_dimlist);
+      break;
+#endif
+
+    case FFESTR_firstTYPE:
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_V020);
+      break;
+
+#if FFESTR_F90
+    case FFESTR_firstTYPE:
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_type);
+      break;
+#endif
+
+#if HARD_F90
+    case FFESTR_firstTYPE:
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_typetype);
+      break;
+#endif
+
+#if FFESTR_VXT
+    case FFESTR_firstUNLOCK:
+      ffestb_args.beru.len = FFESTR_firstlUNLOCK;
+      ffestb_args.beru.badname = "UNLOCK";
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_beru);
+      break;
+#endif
+
+#if FFESTR_VXT
+    case FFESTR_firstUNION:
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_V009);
+      break;
+#endif
+
+#if FFESTR_F90
+    case FFESTR_firstUSE:
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R1107);
+      break;
+#endif
+
+    case FFESTR_firstVIRTUAL:
+      ffestb_args.R524.len = FFESTR_firstlVIRTUAL;
+      ffestb_args.R524.badname = "VIRTUAL";
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R524);
+      break;
+
+    case FFESTR_firstVOLATILE:
+      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_V014);
+      break;
+
+#if HARD_F90
+    case FFESTR_firstWHERE:
+      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_where);
+      break;
+#endif
+
+    case FFESTR_firstWORD:
+      ffestb_args.decl.len = FFESTR_firstlWORD;
+      ffestb_args.decl.type = FFESTP_typeWORD;
+      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;
+
+#if FFESTR_F90
+    case FFELEX_typePERCENT:
+#endif
+    case FFELEX_typeEQUALS:
+#if FFESTR_F90
+    case FFELEX_typePOINTS:
+#endif
+      ffesta_add_possible_unnamed_exec_ ((ffelexHandler) ffestb_let);
+      break;
+
+    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 ()
+{
+  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 ()
+{
+  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 ();
+      ffesymbol_report_all ();
+    }
+}
+
+/* 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 ()
+{
+  ffestaPossible_ ptr;
+  int i;
+
+  ptr = (ffestaPossible_) 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 ()
+{
+  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 ()
+{
+  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, 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, 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, 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 ();
+    }
+}
+
+/* ffesta_set_outpooldisp -- Set disposition of statement output pool
+
+   ffesta_set_outpooldisp(FFESTA_pooldispPRESERVE);  */
+
+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 ()
+{
+  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 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 ();
+      ffesymbol_report_all ();
+    }
+
+  ffelex_set_names (TRUE);
+  return (ffelexHandler) ffesta_first;
+}
diff --git a/gcc/f/sta.h b/gcc/f/sta.h
new file mode 100644
index 00000000000..132d0e84d4b
--- /dev/null
+++ b/gcc/f/sta.h
@@ -0,0 +1,116 @@
+/* sta.h -- Private #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_sta
+#define _H_f_sta
+
+/* 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, char *s, ffelexToken names_token,
+			ffeTokenLength index, ffelexToken next_token);
+void ffesta_ffebad_1st (ffebad msg, char *s, ffelexToken t);
+void ffesta_ffebad_1t (ffebad msg, ffelexToken t);
+void ffesta_ffebad_2st (ffebad msg, 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);
+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
diff --git a/gcc/f/stb.c b/gcc/f/stb.c
new file mode 100644
index 00000000000..90ecc5f8f47
--- /dev/null
+++ b/gcc/f/stb.c
@@ -0,0 +1,25192 @@
+/* stb.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 <ctype.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;
+#if FFESTR_F90
+    struct
+      {
+	ffestrOther kw;
+      }
+    type;
+#endif
+    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;
+#if FFESTR_F90
+    struct
+      {
+	bool started;
+      }
+    moduleprocedure;
+#endif
+    struct
+      {
+	ffebld expr;
+      }
+    selectcase;
+    struct
+      {
+	ffesttCaseList cases;
+      }
+    case_stmt;
+#if FFESTR_F90
+    struct
+      {
+	ffesttExprList exprs;
+	ffebld expr;
+      }
+    heap;
+#endif
+#if FFESTR_F90
+    struct
+      {
+	ffesttExprList exprs;
+      }
+    R624;
+#endif
+#if FFESTR_F90
+    struct
+      {
+	ffestpDefinedOperator operator;
+	bool assignment;	/* TRUE for INTERFACE ASSIGNMENT, FALSE for
+				   ...OPERATOR. */
+	bool slash;		/* TRUE if OPEN_ARRAY, FALSE if OPEN_PAREN. */
+      }
+    interface;
+#endif
+    struct
+      {
+	bool is_cblock;
+      }
+    V014;
+#if FFESTR_VXT
+    struct
+      {
+	bool started;
+	ffebld u;
+	ffebld m;
+	ffebld n;
+	ffebld asv;
+      }
+    V025;
+#endif
+    struct
+      {
+	ffestpBeruIx ix;
+	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;
+#if FFESTR_F90
+    struct
+      {
+	bool started;
+      }
+    structure;
+#endif
+    struct
+      {
+	bool started;
+      }
+    common;
+    struct
+      {
+	bool started;
+      }
+    dimension;
+    struct
+      {
+	bool started;
+      }
+    dimlist;
+    struct
+      {
+	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. */
+	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);
+#if FFESTR_F90
+static ffelexHandler ffestb_decl_typetype1_ (ffelexToken t);
+static ffelexHandler ffestb_decl_typetype2_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_subr_label_list_ (ffelexToken t);
+static ffelexHandler ffestb_subr_label_list_1_ (ffelexToken t);
+static ffelexHandler ffestb_do1_ (ffelexToken t);
+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);
+#if FFESTR_F90
+static ffelexHandler ffestb_type1_ (ffelexToken t);
+static ffelexHandler ffestb_type2_ (ffelexToken t);
+static ffelexHandler ffestb_type3_ (ffelexToken t);
+static ffelexHandler ffestb_type4_ (ffelexToken t);
+#endif
+#if FFESTR_F90
+static ffelexHandler ffestb_varlist1_ (ffelexToken t);
+static ffelexHandler ffestb_varlist2_ (ffelexToken t);
+static ffelexHandler ffestb_varlist3_ (ffelexToken t);
+static ffelexHandler ffestb_varlist4_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_varlist5_ (ffelexToken t);
+static ffelexHandler ffestb_varlist6_ (ffelexToken t);
+#if FFESTR_F90
+static ffelexHandler ffestb_where1_ (ffelexToken ft, ffebld expr,
+				     ffelexToken t);
+static ffelexHandler ffestb_where2_ (ffelexToken t);
+static ffelexHandler ffestb_where3_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_R5221_ (ffelexToken t);
+static ffelexHandler ffestb_R5222_ (ffelexToken t);
+static ffelexHandler ffestb_R5223_ (ffelexToken t);
+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);
+#if FFESTR_F90
+static ffelexHandler ffestb_heap1_ (ffelexToken ft, ffebld expr,
+				    ffelexToken t);
+static ffelexHandler ffestb_heap2_ (ffelexToken t);
+static ffelexHandler ffestb_heap3_ (ffelexToken t);
+static ffelexHandler ffestb_heap4_ (ffelexToken ft, ffebld expr,
+				    ffelexToken t);
+static ffelexHandler ffestb_heap5_ (ffelexToken t);
+#endif
+#if FFESTR_F90
+static ffelexHandler ffestb_module1_ (ffelexToken t);
+static ffelexHandler ffestb_module2_ (ffelexToken t);
+static ffelexHandler ffestb_module3_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_R8091_ (ffelexToken t);
+static ffelexHandler ffestb_R8092_ (ffelexToken ft, ffebld expr,
+				    ffelexToken t);
+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);
+#if FFESTR_F90
+static ffelexHandler ffestb_R11071_ (ffelexToken t);
+static ffelexHandler ffestb_R11072_ (ffelexToken t);
+static ffelexHandler ffestb_R11073_ (ffelexToken t);
+static ffelexHandler ffestb_R11074_ (ffelexToken t);
+static ffelexHandler ffestb_R11075_ (ffelexToken t);
+static ffelexHandler ffestb_R11076_ (ffelexToken t);
+static ffelexHandler ffestb_R11077_ (ffelexToken t);
+static ffelexHandler ffestb_R11078_ (ffelexToken t);
+static ffelexHandler ffestb_R11079_ (ffelexToken t);
+static ffelexHandler ffestb_R110710_ (ffelexToken t);
+static ffelexHandler ffestb_R110711_ (ffelexToken t);
+static ffelexHandler ffestb_R110712_ (ffelexToken t);
+#endif
+#if FFESTR_F90
+static ffelexHandler ffestb_R12021_ (ffelexToken t);
+static ffelexHandler ffestb_R12022_ (ffelexToken t);
+static ffelexHandler ffestb_R12023_ (ffelexToken t);
+static ffelexHandler ffestb_R12024_ (ffelexToken t);
+static ffelexHandler ffestb_R12025_ (ffelexToken t);
+static ffelexHandler ffestb_R12026_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_S3P41_ (ffelexToken ft, ffebld expr,
+				    ffelexToken t);
+static ffelexHandler ffestb_V0141_ (ffelexToken t);
+static ffelexHandler ffestb_V0142_ (ffelexToken t);
+static ffelexHandler ffestb_V0143_ (ffelexToken t);
+static ffelexHandler ffestb_V0144_ (ffelexToken t);
+#if FFESTR_VXT
+static ffelexHandler ffestb_V0251_ (ffelexToken t);
+static ffelexHandler ffestb_V0252_ (ffelexToken ft, ffebld expr,
+				    ffelexToken t);
+static ffelexHandler ffestb_V0253_ (ffelexToken ft, ffebld expr,
+				    ffelexToken t);
+static ffelexHandler ffestb_V0254_ (ffelexToken ft, ffebld expr,
+				    ffelexToken t);
+static ffelexHandler ffestb_V0255_ (ffelexToken t);
+static ffelexHandler ffestb_V0256_ (ffelexToken t);
+static ffelexHandler ffestb_V0257_ (ffelexToken ft, ffebld expr,
+				    ffelexToken t);
+static ffelexHandler ffestb_V0258_ (ffelexToken t);
+#endif
+#if FFESTB_KILL_EASY_
+static void ffestb_subr_kill_easy_ (ffestpInquireIx max);
+#else
+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);
+#if FFESTR_VXT
+static ffelexHandler ffestb_vxtcode1_ (ffelexToken ft, ffebld expr,
+				       ffelexToken t);
+static ffelexHandler ffestb_vxtcode2_ (ffelexToken ft, ffebld expr,
+				       ffelexToken t);
+static ffelexHandler ffestb_vxtcode3_ (ffelexToken ft, ffebld expr,
+				       ffelexToken t);
+static ffelexHandler ffestb_vxtcode4_ (ffelexToken t);
+static ffelexHandler ffestb_vxtcode5_ (ffelexToken t);
+static ffelexHandler ffestb_vxtcode6_ (ffelexToken ft, ffebld expr,
+				       ffelexToken t);
+static ffelexHandler ffestb_vxtcode7_ (ffelexToken t);
+static ffelexHandler ffestb_vxtcode8_ (ffelexToken t);
+static ffelexHandler ffestb_vxtcode9_ (ffelexToken t);
+static ffelexHandler ffestb_vxtcode10_ (ffelexToken ft, ffebld expr,
+					ffelexToken t);
+#endif
+static ffelexHandler ffestb_R9041_ (ffelexToken t);
+static ffelexHandler ffestb_R9042_ (ffelexToken t);
+static ffelexHandler ffestb_R9043_ (ffelexToken ft, ffebld expr,
+				    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);
+#if FFESTR_VXT
+static ffelexHandler ffestb_V0181_ (ffelexToken t);
+static ffelexHandler ffestb_V0182_ (ffelexToken t);
+static ffelexHandler ffestb_V0183_ (ffelexToken ft, ffebld expr,
+				    ffelexToken t);
+static ffelexHandler ffestb_V0184_ (ffelexToken t);
+static ffelexHandler ffestb_V0185_ (ffelexToken t);
+static ffelexHandler ffestb_V0186_ (ffelexToken ft, ffebld expr,
+				    ffelexToken t);
+static ffelexHandler ffestb_V0187_ (ffelexToken t);
+static ffelexHandler ffestb_V0188_ (ffelexToken t);
+static ffelexHandler ffestb_V0189_ (ffelexToken ft, ffebld expr,
+				    ffelexToken t);
+static ffelexHandler ffestb_V01810_ (ffelexToken t);
+static ffelexHandler ffestb_V01811_ (ffelexToken t);
+static ffelexHandler ffestb_V01812_ (ffelexToken t);
+static ffelexHandler ffestb_V01813_ (ffelexToken ft, ffebld expr,
+				     ffelexToken t);
+static ffelexHandler ffestb_V0191_ (ffelexToken ft, ffebld expr,
+				    ffelexToken t);
+static ffelexHandler ffestb_V0192_ (ffelexToken ft, ffebld expr,
+				    ffelexToken t);
+#endif
+static ffelexHandler ffestb_V0201_ (ffelexToken ft, ffebld expr,
+				    ffelexToken t);
+static ffelexHandler ffestb_V0202_ (ffelexToken ft, ffebld expr,
+				    ffelexToken t);
+#if FFESTR_VXT
+static ffelexHandler ffestb_V0211_ (ffelexToken t);
+static ffelexHandler ffestb_V0212_ (ffelexToken t);
+static ffelexHandler ffestb_V0213_ (ffelexToken ft, ffebld expr,
+				    ffelexToken t);
+static ffelexHandler ffestb_V0214_ (ffelexToken t);
+static ffelexHandler ffestb_V0215_ (ffelexToken t);
+static ffelexHandler ffestb_V0216_ (ffelexToken ft, ffebld expr,
+				    ffelexToken t);
+static ffelexHandler ffestb_V0217_ (ffelexToken t);
+static ffelexHandler ffestb_V0218_ (ffelexToken t);
+static ffelexHandler ffestb_V0219_ (ffelexToken t);
+static ffelexHandler ffestb_V0261_ (ffelexToken t);
+static ffelexHandler ffestb_V0262_ (ffelexToken t);
+static ffelexHandler ffestb_V0263_ (ffelexToken ft, ffebld expr,
+				    ffelexToken t);
+static ffelexHandler ffestb_V0264_ (ffelexToken t);
+static ffelexHandler ffestb_V0265_ (ffelexToken t);
+static ffelexHandler ffestb_V0266_ (ffelexToken ft, ffebld expr,
+				    ffelexToken t);
+static ffelexHandler ffestb_V0267_ (ffelexToken t);
+static ffelexHandler ffestb_V0268_ (ffelexToken t);
+static ffelexHandler ffestb_V0269_ (ffelexToken t);
+#endif
+#if FFESTR_F90
+static ffelexHandler ffestb_dimlist1_ (ffelexToken t);
+static ffelexHandler ffestb_dimlist2_ (ffelexToken t);
+static ffelexHandler ffestb_dimlist3_ (ffelexToken t);
+static ffelexHandler ffestb_dimlist4_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_dummy1_ (ffelexToken t);
+static ffelexHandler ffestb_dummy2_ (ffelexToken t);
+static ffelexHandler ffestb_R5241_ (ffelexToken t);
+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);
+#if FFESTR_F90
+static ffelexHandler ffestb_R6241_ (ffelexToken ft, ffebld expr,
+				    ffelexToken t);
+static ffelexHandler ffestb_R6242_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_R12291_ (ffelexToken t);
+static ffelexHandler ffestb_R12292_ (ffelexToken ft, ffebld expr,
+				     ffelexToken t);
+static ffelexHandler ffestb_decl_chartype1_ (ffelexToken t);
+#if FFESTR_F90
+static ffelexHandler ffestb_decl_recursive1_ (ffelexToken t);
+static ffelexHandler ffestb_decl_recursive2_ (ffelexToken t);
+static ffelexHandler ffestb_decl_recursive3_ (ffelexToken t);
+static ffelexHandler ffestb_decl_recursive4_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_decl_attrs_ (ffelexToken t);
+static ffelexHandler ffestb_decl_attrs_1_ (ffelexToken t);
+static ffelexHandler ffestb_decl_attrs_2_ (ffelexToken t);
+#if FFESTR_F90
+static ffelexHandler ffestb_decl_attrs_3_ (ffelexToken t);
+static ffelexHandler ffestb_decl_attrs_4_ (ffelexToken t);
+static ffelexHandler ffestb_decl_attrs_5_ (ffelexToken t);
+static ffelexHandler ffestb_decl_attrs_6_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_decl_attrs_7_ (ffelexToken t);
+static ffelexHandler ffestb_decl_attrsp_ (ffelexToken t);
+static ffelexHandler ffestb_decl_ents_ (ffelexToken t);
+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);
+#if FFESTR_F90
+static ffelexHandler ffestb_decl_func_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_decl_funcname_ (ffelexToken t);
+static ffelexHandler ffestb_decl_funcname_1_ (ffelexToken t);
+static ffelexHandler ffestb_decl_funcname_2_ (ffelexToken t);
+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);
+#if FFESTR_VXT
+static ffelexHandler ffestb_V0031_ (ffelexToken t);
+static ffelexHandler ffestb_V0032_ (ffelexToken t);
+static ffelexHandler ffestb_V0033_ (ffelexToken t);
+static ffelexHandler ffestb_V0034_ (ffelexToken t);
+static ffelexHandler ffestb_V0035_ (ffelexToken t);
+static ffelexHandler ffestb_V0036_ (ffelexToken t);
+static ffelexHandler ffestb_V0161_ (ffelexToken t);
+static ffelexHandler ffestb_V0162_ (ffelexToken t);
+static ffelexHandler ffestb_V0163_ (ffelexToken t);
+static ffelexHandler ffestb_V0164_ (ffelexToken t);
+static ffelexHandler ffestb_V0165_ (ffelexToken t);
+static ffelexHandler ffestb_V0166_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_V0271_ (ffelexToken t);
+static ffelexHandler ffestb_V0272_ (ffelexToken ft, ffebld expr,
+				    ffelexToken t);
+static ffelexHandler ffestb_V0273_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R5391_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R5392_ (ffelexToken t);
+#if FFESTR_F90
+static ffelexHandler ffestb_decl_R5393_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_decl_R5394_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R5395_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R539letters_ (ffelexToken t);
+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_ ()
+{
+  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_decl_typetype1_ -- "TYPE" OPEN_PAREN
+
+   return ffestb_decl_typetype1_;  // to lexer
+
+   Handle NAME.	 */
+
+#if FFESTR_F90
+static ffelexHandler
+ffestb_decl_typetype1_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      ffestb_local_.decl.kindt = ffelex_token_use (t);
+      return (ffelexHandler) ffestb_decl_typetype2_;
+
+    default:
+      break;
+    }
+
+  if (ffestb_local_.decl.recursive != NULL)
+    ffelex_token_kill (ffestb_local_.decl.recursive);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+		    ffestb_local_.decl.badname,
+		    t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_typetype2_ -- "TYPE" OPEN_PAREN NAME
+
+   return ffestb_decl_typetype2_;  // to lexer
+
+   Handle CLOSE_PAREN.	*/
+
+static ffelexHandler
+ffestb_decl_typetype2_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCLOSE_PAREN:
+      ffestb_local_.decl.type = FFESTP_typeTYPE;
+      ffestb_local_.decl.kind = NULL;
+      ffestb_local_.decl.len = NULL;
+      ffestb_local_.decl.lent = NULL;
+      ffelex_set_names (TRUE);
+      return (ffelexHandler) ffestb_local_.decl.handler;
+
+    default:
+      break;
+    }
+
+  if (ffestb_local_.decl.recursive != NULL)
+    ffelex_token_kill (ffestb_local_.decl.recursive);
+  ffelex_token_kill (ffestb_local_.decl.kindt);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+		    ffestb_local_.decl.badname,
+		    t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_subr_label_list_ -- Collect a tokenlist of labels and close-paren
+
+   return ffestb_subr_label_list_;  // to lexer after seeing OPEN_PAREN
+
+   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;
+  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;
+  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;
+  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;
+  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);
+#if FFESTR_F90
+      if ((ffestb_args.elsexyz.second == FFESTR_secondWHERE)
+	  && (ffelex_token_length (ffesta_tokens[1]) != FFESTR_secondlWHERE))
+	ffestb_args.elsexyz.second = FFESTR_secondNone;
+#endif
+      return (ffelexHandler) ffestb_else1_ (t);
+
+    default:
+      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)
+    {
+#if FFESTR_F90
+    case FFESTR_secondWHERE:
+      if (!ffesta_is_inhibited ())
+	if ((ffesta_first_kw == FFESTR_firstELSEWHERE)
+	    && (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME))
+	  ffestc_R744 ();
+	else
+	  ffestc_elsewhere (ffesta_tokens[1]);	/* R744 or R805. */
+      break;
+#endif
+
+    default:
+      if (!ffesta_is_inhibited ())
+	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;
+  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_;
+
+#if FFESTR_F90
+	case FFESTR_secondINTERFACE:
+#endif
+#if FFESTR_VXT
+	case FFESTR_secondMAP:
+	case FFESTR_secondSTRUCTURE:
+	case FFESTR_secondUNION:
+#endif
+#if FFESTR_F90
+	case FFESTR_secondWHERE:
+	  ffesta_tokens[1] = NULL;
+	  return (ffelexHandler) ffestb_end3_;
+#endif
+
+	case FFESTR_secondNone:
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	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;
+  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)
+	    {
+#if FFESTR_F90
+	    case FFESTR_secondINTERFACE:
+#endif
+#if FFESTR_VXT
+	    case FFESTR_secondMAP:
+	    case FFESTR_secondSTRUCTURE:
+	    case FFESTR_secondUNION:
+#endif
+#if FFESTR_F90
+	    case FFESTR_secondWHERE:
+	      goto bad_1;	/* :::::::::::::::::::: */
+#endif
+
+	    case FFESTR_secondBLOCK:
+	      if (ffesta_second_kw != FFESTR_secondDATA)
+		goto bad_1;	/* :::::::::::::::::::: */
+	      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);
+	  switch (ffestb_args.endxyz.second)
+	    {
+#if FFESTR_F90
+	    case FFESTR_secondINTERFACE:
+#endif
+#if FFESTR_VXT
+	    case FFESTR_secondMAP:
+	    case FFESTR_secondSTRUCTURE:
+	    case FFESTR_secondUNION:
+#endif
+#if FFESTR_F90
+	    case FFESTR_secondWHERE:
+	      goto bad_i;	/* :::::::::::::::::::: */
+#endif
+
+	    default:
+	      break;
+	    }
+	  if (!ffesrc_is_name_init (*p))
+	    goto bad_i;		/* :::::::::::::::::::: */
+	  ffesta_tokens[1]
+	    = 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)
+    {
+#if FFESTR_F90
+    case FFESTR_secondTYPE:
+      if (!ffesta_is_inhibited ())
+	ffestc_R425 (ffesta_tokens[1]);
+      break;
+#endif
+
+#if FFESTR_F90
+    case FFESTR_secondWHERE:
+      if (!ffesta_is_inhibited ())
+	ffestc_R745 ();
+      break;
+#endif
+
+    case FFESTR_secondIF:
+      if (!ffesta_is_inhibited ())
+	ffestc_R806 (ffesta_tokens[1]);
+      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;
+
+#if FFESTR_F90
+    case FFESTR_secondMODULE:
+      if (!ffesta_is_inhibited ())
+	ffestc_R1106 (ffesta_tokens[1]);
+      break;
+#endif
+    case FFESTR_secondBLOCK:
+    case FFESTR_secondBLOCKDATA:
+      if (!ffesta_is_inhibited ())
+	ffestc_R1112 (ffesta_tokens[1]);
+      break;
+
+#if FFESTR_F90
+    case FFESTR_secondINTERFACE:
+      if (!ffesta_is_inhibited ())
+	ffestc_R1203 ();
+      break;
+#endif
+
+    case FFESTR_secondFUNCTION:
+      if (!ffesta_is_inhibited ())
+	ffestc_R1221 (ffesta_tokens[1]);
+      break;
+
+    case FFESTR_secondSUBROUTINE:
+      if (!ffesta_is_inhibited ())
+	ffestc_R1225 (ffesta_tokens[1]);
+      break;
+
+#if FFESTR_VXT
+    case FFESTR_secondSTRUCTURE:
+      if (!ffesta_is_inhibited ())
+	ffestc_V004 ();
+      break;
+#endif
+
+#if FFESTR_VXT
+    case FFESTR_secondUNION:
+      if (!ffesta_is_inhibited ())
+	ffestc_V010 ();
+      break;
+#endif
+
+#if FFESTR_VXT
+    case FFESTR_secondMAP:
+      if (!ffesta_is_inhibited ())
+	ffestc_V013 ();
+      break;
+#endif
+
+    default:
+      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0]);
+      if (ffesta_tokens[1] != NULL)
+	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;
+  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_where -- Parse a WHERE statement
+
+   return ffestb_where;	 // to lexer
+
+   Make sure the statement has a valid form for a WHERE statement.
+   If it does, implement the statement.	 */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_where (ffelexToken t)
+{
+  switch (ffelex_token_type (ffesta_tokens[0]))
+    {
+    case FFELEX_typeNAME:
+      if (ffesta_first_kw != FFESTR_firstWHERE)
+	goto bad_0;		/* :::::::::::::::::::: */
+      break;
+
+    case FFELEX_typeNAMES:
+      if (ffesta_first_kw != FFESTR_firstWHERE)
+	goto bad_0;		/* :::::::::::::::::::: */
+      if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlWHERE)
+	goto bad_0;		/* :::::::::::::::::::: */
+      break;
+
+    default:
+      goto bad_0;		/* :::::::::::::::::::: */
+    }
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeOPEN_PAREN:
+      break;
+
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeCOLONCOLON:
+      ffesta_confirmed ();	/* Error, but clearly intended. */
+      goto bad_1;		/* :::::::::::::::::::: */
+
+    default:
+      goto bad_1;		/* :::::::::::::::::::: */
+    }
+
+  return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextWHERE,
+				      (ffeexprCallback) ffestb_where1_);
+
+bad_0:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", ffesta_tokens[0]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t,
+						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
+}
+
+#endif
+/* ffestb_where1_ -- "WHERE" OPEN_PAREN expr
+
+   (ffestb_where1_)  // to expression handler
+
+   Make sure the next token is CLOSE_PAREN.  */
+
+#if FFESTR_F90
+static ffelexHandler
+ffestb_where1_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  ffestb_local_.if_stmt.expr = expr;
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCLOSE_PAREN:
+      if (expr == NULL)
+	break;
+      ffesta_tokens[1] = ffelex_token_use (ft);
+      ffelex_set_names (TRUE);
+      return (ffelexHandler) ffestb_where2_;
+
+    default:
+      break;
+    }
+
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_where2_ -- "WHERE" OPEN_PAREN expr CLOSE_PAREN
+
+   return ffestb_where2_;  // to lexer
+
+   Make sure the next token is NAME.  */
+
+#if FFESTR_F90
+static ffelexHandler
+ffestb_where2_ (ffelexToken t)
+{
+  ffelex_set_names (FALSE);
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+    case FFELEX_typeNAMES:
+      ffesta_confirmed ();
+      ffesta_tokens[2] = ffelex_token_use (t);
+      return (ffelexHandler) ffestb_where3_;
+
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      ffesta_confirmed ();
+      if (!ffesta_is_inhibited ())
+	ffestc_R742 (ffestb_local_.if_stmt.expr, ffesta_tokens[1]);
+      ffelex_token_kill (ffesta_tokens[1]);
+      return (ffelexHandler) ffesta_zero (t);
+
+    default:
+      break;
+    }
+
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", t);
+  ffelex_token_kill (ffesta_tokens[1]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_where3_ -- "WHERE" OPEN_PAREN expr CLOSE_PAREN NAME
+
+   return ffestb_where3_;  // to lexer
+
+   Implement R742.  */
+
+#if FFESTR_F90
+static ffelexHandler
+ffestb_where3_ (ffelexToken t)
+{
+  ffelexHandler next;
+  ffelexToken my_2 = ffesta_tokens[2];
+
+  if (!ffesta_is_inhibited ())
+    ffestc_R740 (ffestb_local_.if_stmt.expr, ffesta_tokens[1]);
+  ffelex_token_kill (ffesta_tokens[1]);
+  next = (ffelexHandler) ffesta_two (my_2, t);
+  ffelex_token_kill (my_2);
+  return (ffelexHandler) next;
+}
+
+#endif
+/* ffestb_let -- Parse an assignment statement
+
+   return ffestb_let;  // to lexer
+
+   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. */
+  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))
+    {
+#if FFESTR_F90
+    case FFELEX_typePOINTS:
+#endif
+    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 ())
+#if FFESTR_F90
+	if (ffelex_token_type (ffesta_tokens[1]) == FFELEX_typeEQUALS)
+#endif
+	  ffestc_let (ffestb_local_.let.dest, expr, ft);
+#if FFESTR_F90
+	else
+	  ffestc_R738 (ffestb_local_.let.dest, expr, ft);
+#endif
+      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_type -- Parse the TYPE statement
+
+   return ffestb_type;	// to lexer
+
+   Make sure the statement has a valid form for the TYPE statement.  If
+   it does, implement the statement.  */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_type (ffelexToken t)
+{
+  ffeTokenLength i;
+  char *p;
+
+  switch (ffelex_token_type (ffesta_tokens[0]))
+    {
+    case FFELEX_typeNAME:
+      if (ffesta_first_kw != FFESTR_firstTYPE)
+	goto bad_0;		/* :::::::::::::::::::: */
+      switch (ffelex_token_type (t))
+	{
+	case FFELEX_typeEOS:
+	case FFELEX_typeSEMICOLON:
+	case FFELEX_typeCOLONCOLON:
+	  ffesta_confirmed ();	/* Error, but clearly intended. */
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	default:
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	case FFELEX_typeCOMMA:
+	  ffesta_confirmed ();
+	  return (ffelexHandler) ffestb_type1_;
+
+	case FFELEX_typeNAME:	/* No confirm here, because ambig w/V020 VXT
+				   TYPE. */
+	  ffesta_tokens[1] = NULL;
+	  ffesta_tokens[2] = ffelex_token_use (t);
+	  return (ffelexHandler) ffestb_type4_;
+	}
+
+    case FFELEX_typeNAMES:
+      if (ffesta_first_kw != FFESTR_firstTYPE)
+	goto bad_0;		/* :::::::::::::::::::: */
+      p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlTYPE);
+      switch (ffelex_token_type (t))
+	{
+	default:
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	case FFELEX_typeCOMMA:
+	  if (*p != '\0')
+	    goto bad_i;		/* :::::::::::::::::::: */
+	  ffesta_confirmed ();
+	  ffelex_set_names (TRUE);
+	  return (ffelexHandler) ffestb_type1_;
+
+	case FFELEX_typeEOS:
+	case FFELEX_typeSEMICOLON:
+	  break;
+	}
+      if (!ffesrc_is_name_init (*p))
+	goto bad_i;		/* :::::::::::::::::::: */
+      ffesta_tokens[1] = NULL;
+      ffesta_tokens[2]
+	= ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+      return (ffelexHandler) ffestb_type4_ (t);
+
+    default:
+      goto bad_0;		/* :::::::::::::::::::: */
+    }
+
+bad_0:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", ffesta_tokens[0]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t,
+						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
+
+bad_i:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "TYPE", ffesta_tokens[0], i, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_type1_ -- "TYPE" COMMA
+
+   return ffestb_type1_;  // to lexer
+
+   Make sure the next token is a NAME.	*/
+
+static ffelexHandler
+ffestb_type1_ (ffelexToken t)
+{
+  ffeTokenLength i;
+  char *p;
+
+  ffelex_set_names (FALSE);
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      ffesta_tokens[1] = ffelex_token_use (t);
+      ffestb_local_.type.kw = ffestr_other (t);
+      switch (ffestb_local_.varlist.kw)
+	{
+	case FFESTR_otherPUBLIC:
+	case FFESTR_otherPRIVATE:
+	  return (ffelexHandler) ffestb_type2_;
+
+	default:
+	  ffelex_token_kill (ffesta_tokens[1]);
+	  break;
+	}
+      break;
+
+    case FFELEX_typeNAMES:
+      ffesta_tokens[1] = ffelex_token_use (t);
+      ffestb_local_.type.kw = ffestr_other (t);
+      switch (ffestb_local_.varlist.kw)
+	{
+	case FFESTR_otherPUBLIC:
+	  p = ffelex_token_text (t) + (i = FFESTR_otherlPUBLIC);
+	  if (*p == '\0')
+	    return (ffelexHandler) ffestb_type2_;
+	  if (!ffesrc_is_name_init (*p))
+	    goto bad_i1;	/* :::::::::::::::::::: */
+	  ffesta_tokens[2] = ffelex_token_name_from_names (t, i, 0);
+	  return (ffelexHandler) ffestb_type4_;
+
+	case FFESTR_otherPRIVATE:
+	  p = ffelex_token_text (t) + (i = FFESTR_otherlPRIVATE);
+	  if (*p == '\0')
+	    return (ffelexHandler) ffestb_type2_;
+	  if (!ffesrc_is_name_init (*p))
+	    goto bad_i1;	/* :::::::::::::::::::: */
+	  ffesta_tokens[2] = ffelex_token_name_from_names (t, i, 0);
+	  return (ffelexHandler) ffestb_type4_;
+
+	default:
+	  ffelex_token_kill (ffesta_tokens[1]);
+	  break;
+	}
+      break;
+
+    default:
+      break;
+    }
+
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_i1:			/* :::::::::::::::::::: */
+  ffelex_token_kill (ffesta_tokens[1]);
+  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "TYPE", t, i, NULL);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_type2_ -- "TYPE" COMMA NAME
+
+   return ffestb_type2_;  // to lexer
+
+   Handle COLONCOLON or NAME.  */
+
+static ffelexHandler
+ffestb_type2_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOLONCOLON:
+      return (ffelexHandler) ffestb_type3_;
+
+    case FFELEX_typeNAME:
+      return (ffelexHandler) ffestb_type3_ (t);
+
+    default:
+      break;
+    }
+
+  if (ffesta_tokens[1] != NULL)
+    ffelex_token_kill (ffesta_tokens[1]);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_type3_ -- "TYPE" [COMMA NAME [COLONCOLON]]
+
+   return ffestb_type3_;  // to lexer
+
+   Make sure the next token is a NAME.	*/
+
+static ffelexHandler
+ffestb_type3_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      ffesta_tokens[2] = ffelex_token_use (t);
+      return (ffelexHandler) ffestb_type4_;
+
+    default:
+      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
+      break;
+    }
+
+  if (ffesta_tokens[1] != NULL)
+    ffelex_token_kill (ffesta_tokens[1]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_type4_ -- "TYPE" [COMMA NAME [COLONCOLON]] NAME
+
+   return ffestb_type4_;  // to lexer
+
+   Make sure the next token is an EOS or SEMICOLON.  */
+
+static ffelexHandler
+ffestb_type4_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      ffesta_confirmed ();
+      if (!ffesta_is_inhibited ())
+	ffestc_R424 (ffesta_tokens[1], ffestb_local_.type.kw,
+		     ffesta_tokens[2]);
+      if (ffesta_tokens[1] != NULL)
+	ffelex_token_kill (ffesta_tokens[1]);
+      ffelex_token_kill (ffesta_tokens[2]);
+      return (ffelexHandler) ffesta_zero (t);
+
+    default:
+      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
+      break;
+    }
+
+  if (ffesta_tokens[1] != NULL)
+    ffelex_token_kill (ffesta_tokens[1]);
+  ffelex_token_kill (ffesta_tokens[2]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_varlist -- Parse EXTERNAL/INTENT/INTRINSIC/OPTIONAL/PUBLIC/PRIVATE
+		     statement
+
+   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;
+  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 ();
+	  switch (ffesta_first_kw)
+	    {
+#if FFESTR_F90
+	    case FFESTR_firstPUBLIC:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R521A ();
+	      return (ffelexHandler) ffesta_zero (t);
+
+	    case FFESTR_firstPRIVATE:
+	      if (!ffesta_is_inhibited ())
+		ffestc_private ();	/* Either R523A or R521B. */
+	      return (ffelexHandler) ffesta_zero (t);
+#endif
+
+	    default:
+	      goto bad_1;	/* :::::::::::::::::::: */
+	    }
+
+	case FFELEX_typeCOMMA:
+	  ffesta_confirmed ();	/* Error, but clearly intended. */
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	case FFELEX_typeCOLONCOLON:
+	  ffesta_confirmed ();
+	  switch (ffesta_first_kw)
+	    {
+#if FFESTR_F90
+	    case FFESTR_firstOPTIONAL:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R520_start ();
+	      break;
+
+	    case FFESTR_firstPUBLIC:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R521Astart ();
+	      break;
+
+	    case FFESTR_firstPRIVATE:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R521Bstart ();
+	      break;
+#endif
+
+	    default:
+	      ffesta_confirmed ();	/* Error, but clearly intended. */
+	      goto bad_1;	/* :::::::::::::::::::: */
+	    }
+	  return (ffelexHandler) ffestb_varlist5_;
+
+	default:
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	case FFELEX_typeOPEN_PAREN:
+	  switch (ffesta_first_kw)
+	    {
+#if FFESTR_F90
+	    case FFESTR_firstINTENT:
+	      return (ffelexHandler) ffestb_varlist1_;
+#endif
+
+	    default:
+	      goto bad_1;	/* :::::::::::::::::::: */
+	    }
+
+	case FFELEX_typeNAME:
+	  ffesta_confirmed ();
+	  switch (ffesta_first_kw)
+	    {
+	    case FFESTR_firstEXTERNAL:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R1207_start ();
+	      break;
+
+#if FFESTR_F90
+	    case FFESTR_firstINTENT:
+	      goto bad_1;	/* :::::::::::::::::::: */
+#endif
+
+	    case FFESTR_firstINTRINSIC:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R1208_start ();
+	      break;
+
+#if FFESTR_F90
+	    case FFESTR_firstOPTIONAL:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R520_start ();
+	      break;
+#endif
+
+#if FFESTR_F90
+	    case FFESTR_firstPUBLIC:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R521Astart ();
+	      break;
+
+	    case FFESTR_firstPRIVATE:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R521Bstart ();
+	      break;
+#endif
+
+	    default:
+	      break;
+	    }
+	  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 ();
+	  switch (ffesta_first_kw)
+	    {
+#if FFESTR_F90
+	    case FFESTR_firstINTENT:
+	      goto bad_1;	/* :::::::::::::::::::: */
+#endif
+
+	    default:
+	      break;
+	    }
+	  if (*p != '\0')
+	    break;
+	  switch (ffesta_first_kw)
+	    {
+#if FFESTR_F90
+	    case FFESTR_firstPUBLIC:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R521A ();
+	      return (ffelexHandler) ffesta_zero (t);
+
+	    case FFESTR_firstPRIVATE:
+	      if (!ffesta_is_inhibited ())
+		ffestc_private ();	/* Either R423A or R521B. */
+	      return (ffelexHandler) ffesta_zero (t);
+#endif
+
+	    default:
+	      goto bad_1;	/* :::::::::::::::::::: */
+	    }
+
+	case FFELEX_typeCOMMA:
+	  ffesta_confirmed ();	/* Error, but clearly intended. */
+	  switch (ffesta_first_kw)
+	    {
+#if FFESTR_F90
+	    case FFESTR_firstINTENT:
+	      goto bad_1;	/* :::::::::::::::::::: */
+#endif
+
+	    default:
+	      break;
+	    }
+	  if (*p != '\0')
+	    break;
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	case FFELEX_typeCOLONCOLON:
+	  ffesta_confirmed ();
+	  switch (ffesta_first_kw)
+	    {
+#if FFESTR_F90
+	    case FFESTR_firstOPTIONAL:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R520_start ();
+	      break;
+#endif
+
+#if FFESTR_F90
+	    case FFESTR_firstPUBLIC:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R521Astart ();
+	      break;
+
+	    case FFESTR_firstPRIVATE:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R521Bstart ();
+	      break;
+#endif
+
+	    default:
+	      goto bad_1;	/* :::::::::::::::::::: */
+	    }
+	  return (ffelexHandler) ffestb_varlist5_;
+
+	case FFELEX_typeOPEN_PAREN:
+	  switch (ffesta_first_kw)
+	    {
+#if FFESTR_F90
+	    case FFESTR_firstINTENT:
+	      if (*p != '\0')
+		goto bad_1;	/* :::::::::::::::::::: */
+	      return (ffelexHandler) ffestb_varlist1_;
+#endif
+
+	    default:
+	      goto bad_1;	/* :::::::::::::::::::: */
+	    }
+
+	case FFELEX_typeNAME:
+	  ffesta_confirmed ();
+	  switch (ffesta_first_kw)
+	    {
+	    case FFESTR_firstEXTERNAL:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R1207_start ();
+	      break;
+
+#if FFESTR_F90
+	    case FFESTR_firstINTENT:
+	      goto bad_1;	/* :::::::::::::::::::: */
+#endif
+
+	    case FFESTR_firstINTRINSIC:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R1208_start ();
+	      break;
+
+#if FFESTR_F90
+	    case FFESTR_firstOPTIONAL:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R520_start ();
+	      break;
+#endif
+
+#if FFESTR_F90
+	    case FFESTR_firstPUBLIC:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R521Astart ();
+	      break;
+
+	    case FFESTR_firstPRIVATE:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R521Bstart ();
+	      break;
+#endif
+
+	    default:
+	      break;
+	    }
+	  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;
+
+#if FFESTR_F90
+	    case FFESTR_firstOPTIONAL:
+	      ffestc_R520_start ();
+	      break;
+#endif
+
+#if FFESTR_F90
+	    case FFESTR_firstPUBLIC:
+	      ffestc_R521Astart ();
+	      break;
+
+	    case FFESTR_firstPRIVATE:
+	      ffestc_R521Bstart ();
+	      break;
+#endif
+
+	    default:
+	      assert (FALSE);
+	    }
+	}
+      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_varlist1_ -- "INTENT" OPEN_PAREN
+
+   return ffestb_varlist1_;  // to lexer
+
+   Handle NAME.	 */
+
+#if FFESTR_F90
+static ffelexHandler
+ffestb_varlist1_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      ffesta_tokens[1] = ffelex_token_use (t);
+      ffestb_local_.varlist.kw = ffestr_other (t);
+      switch (ffestb_local_.varlist.kw)
+	{
+	case FFESTR_otherIN:
+	  return (ffelexHandler) ffestb_varlist2_;
+
+	case FFESTR_otherINOUT:
+	  return (ffelexHandler) ffestb_varlist3_;
+
+	case FFESTR_otherOUT:
+	  return (ffelexHandler) ffestb_varlist3_;
+
+	default:
+	  ffelex_token_kill (ffesta_tokens[1]);
+	  break;
+	}
+      break;
+
+    default:
+      break;
+    }
+
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_varlist2_ -- "INTENT" OPEN_PAREN "IN"
+
+   return ffestb_varlist2_;  // to lexer
+
+   Handle NAME.	 */
+
+static ffelexHandler
+ffestb_varlist2_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      switch (ffestr_other (t))
+	{
+	case FFESTR_otherOUT:
+	  ffestb_local_.varlist.kw = FFESTR_otherINOUT;
+	  return (ffelexHandler) ffestb_varlist3_;
+
+	default:
+	  break;
+	}
+      break;
+
+    case FFELEX_typeCLOSE_PAREN:
+      return (ffelexHandler) ffestb_varlist4_;
+
+    default:
+      break;
+    }
+
+  ffelex_token_kill (ffesta_tokens[1]);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_varlist3_ -- "INTENT" OPEN_PAREN NAME ["OUT"]
+
+   return ffestb_varlist3_;  // to lexer
+
+   Handle CLOSE_PAREN.	*/
+
+static ffelexHandler
+ffestb_varlist3_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCLOSE_PAREN:
+      return (ffelexHandler) ffestb_varlist4_;
+
+    default:
+      break;
+    }
+
+  ffelex_token_kill (ffesta_tokens[1]);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_varlist4_ -- "INTENT" OPEN_PAREN NAME ["OUT"] CLOSE_PAREN
+
+   return ffestb_varlist4_;  // to lexer
+
+   Handle COLONCOLON or NAME.  */
+
+static ffelexHandler
+ffestb_varlist4_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOLONCOLON:
+      ffesta_confirmed ();
+      if (!ffesta_is_inhibited ())
+	ffestc_R519_start (ffesta_tokens[1], ffestb_local_.varlist.kw);
+      ffelex_token_kill (ffesta_tokens[1]);
+      return (ffelexHandler) ffestb_varlist5_;
+
+    case FFELEX_typeNAME:
+      ffesta_confirmed ();
+      if (!ffesta_is_inhibited ())
+	ffestc_R519_start (ffesta_tokens[1], ffestb_local_.varlist.kw);
+      ffelex_token_kill (ffesta_tokens[1]);
+      return (ffelexHandler) ffestb_varlist5_ (t);
+
+    default:
+      break;
+    }
+
+  ffelex_token_kill (ffesta_tokens[1]);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_varlist5_ -- Handles the list of variable names
+
+   return ffestb_varlist5_;  // to lexer
+
+   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;
+
+#if FFESTR_F90
+	case FFESTR_firstINTENT:
+	  ffestc_R519_finish ();
+	  break;
+#endif
+
+	case FFESTR_firstINTRINSIC:
+	  ffestc_R1208_finish ();
+	  break;
+
+#if FFESTR_F90
+	case FFESTR_firstOPTIONAL:
+	  ffestc_R520_finish ();
+	  break;
+#endif
+
+#if FFESTR_F90
+	case FFESTR_firstPUBLIC:
+	  ffestc_R521Afinish ();
+	  break;
+
+	case FFESTR_firstPRIVATE:
+	  ffestc_R521Bfinish ();
+	  break;
+#endif
+
+	default:
+	  assert (FALSE);
+	}
+    }
+  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;
+
+#if FFESTR_F90
+	    case FFESTR_firstINTENT:
+	      ffestc_R519_item (ffesta_tokens[1]);
+	      break;
+#endif
+
+	    case FFESTR_firstINTRINSIC:
+	      ffestc_R1208_item (ffesta_tokens[1]);
+	      break;
+
+#if FFESTR_F90
+	    case FFESTR_firstOPTIONAL:
+	      ffestc_R520_item (ffesta_tokens[1]);
+	      break;
+#endif
+
+#if FFESTR_F90
+	    case FFESTR_firstPUBLIC:
+	      ffestc_R521Aitem (ffesta_tokens[1]);
+	      break;
+
+	    case FFESTR_firstPRIVATE:
+	      ffestc_R521Bitem (ffesta_tokens[1]);
+	      break;
+#endif
+
+	    default:
+	      assert (FALSE);
+	    }
+	}
+      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;
+
+#if FFESTR_F90
+	    case FFESTR_firstINTENT:
+	      ffestc_R519_item (ffesta_tokens[1]);
+	      ffestc_R519_finish ();
+	      break;
+#endif
+
+	    case FFESTR_firstINTRINSIC:
+	      ffestc_R1208_item (ffesta_tokens[1]);
+	      ffestc_R1208_finish ();
+	      break;
+
+#if FFESTR_F90
+	    case FFESTR_firstOPTIONAL:
+	      ffestc_R520_item (ffesta_tokens[1]);
+	      ffestc_R520_finish ();
+	      break;
+#endif
+
+#if FFESTR_F90
+	    case FFESTR_firstPUBLIC:
+	      ffestc_R521Aitem (ffesta_tokens[1]);
+	      ffestc_R521Afinish ();
+	      break;
+
+	    case FFESTR_firstPRIVATE:
+	      ffestc_R521Bitem (ffesta_tokens[1]);
+	      ffestc_R521Bfinish ();
+	      break;
+#endif
+
+	    default:
+	      assert (FALSE);
+	    }
+	}
+      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;
+
+#if FFESTR_F90
+	case FFESTR_firstINTENT:
+	  ffestc_R519_finish ();
+	  break;
+#endif
+
+	case FFESTR_firstINTRINSIC:
+	  ffestc_R1208_finish ();
+	  break;
+
+#if FFESTR_F90
+	case FFESTR_firstOPTIONAL:
+	  ffestc_R520_finish ();
+	  break;
+#endif
+
+#if FFESTR_F90
+	case FFESTR_firstPUBLIC:
+	  ffestc_R521Afinish ();
+	  break;
+
+	case FFESTR_firstPRIVATE:
+	  ffestc_R521Bfinish ();
+	  break;
+#endif
+
+	default:
+	  assert (FALSE);
+	}
+    }
+  ffelex_token_kill (ffesta_tokens[1]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R423B -- Parse the SEQUENCE statement
+
+   return ffestb_R423B;	 // to lexer
+
+   Make sure the statement has a valid form for the SEQUENCE statement.	 If
+   it does, implement the statement.  */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_R423B (ffelexToken t)
+{
+  char *p;
+  ffeTokenLength i;
+
+  switch (ffelex_token_type (ffesta_tokens[0]))
+    {
+    case FFELEX_typeNAME:
+      if (ffesta_first_kw != FFESTR_firstSEQUENCE)
+	goto bad_0;		/* :::::::::::::::::::: */
+      break;
+
+    case FFELEX_typeNAMES:
+      if (ffesta_first_kw != FFESTR_firstSEQUENCE)
+	goto bad_0;		/* :::::::::::::::::::: */
+      if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlSEQUENCE)
+	{
+	  p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSEQUENCE);
+	  goto bad_i;		/* :::::::::::::::::::: */
+	}
+      break;
+
+    default:
+      goto bad_0;		/* :::::::::::::::::::: */
+    }
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      ffesta_confirmed ();
+      if (!ffesta_is_inhibited ())
+	ffestc_R423B ();
+      return (ffelexHandler) ffesta_zero (t);
+
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeCOLONCOLON:
+      ffesta_confirmed ();	/* Error, but clearly intended. */
+      goto bad_1;		/* :::::::::::::::::::: */
+
+    default:
+      goto bad_1;		/* :::::::::::::::::::: */
+    }
+
+bad_0:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SEQUENCE", ffesta_tokens[0]);
+  return (ffelexHandler) ffelex_swallow_tokens (t,
+						(ffelexHandler) ffesta_zero);	/* Invalid first token. */
+
+bad_1:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SEQUENCE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t,
+						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
+
+bad_i:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "SEQUENCE", ffesta_tokens[0], i, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_R522 -- Parse the SAVE statement
+
+   return ffestb_R522;	// to lexer
+
+   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;
+  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)
+{
+  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 = expr;
+      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:
+      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)
+{
+  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;
+  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;
+  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)
+{
+  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)
+{
+  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;
+  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;
+  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;
+  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_R1228 -- Parse the CONTAINS statement
+
+   return ffestb_R1228;	 // to lexer
+
+   Make sure the statement has a valid form for the CONTAINS statement.	 If
+   it does, implement the statement.  */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_R1228 (ffelexToken t)
+{
+  char *p;
+  ffeTokenLength i;
+
+  switch (ffelex_token_type (ffesta_tokens[0]))
+    {
+    case FFELEX_typeNAME:
+      if (ffesta_first_kw != FFESTR_firstCONTAINS)
+	goto bad_0;		/* :::::::::::::::::::: */
+      break;
+
+    case FFELEX_typeNAMES:
+      if (ffesta_first_kw != FFESTR_firstCONTAINS)
+	goto bad_0;		/* :::::::::::::::::::: */
+      if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlCONTAINS)
+	{
+	  p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCONTAINS);
+	  goto bad_i;		/* :::::::::::::::::::: */
+	}
+      break;
+
+    default:
+      goto bad_0;		/* :::::::::::::::::::: */
+    }
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      ffesta_confirmed ();
+      if (!ffesta_is_inhibited ())
+	ffestc_R1228 ();
+      return (ffelexHandler) ffesta_zero (t);
+
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeCOLONCOLON:
+      ffesta_confirmed ();	/* Error, but clearly intended. */
+      goto bad_1;		/* :::::::::::::::::::: */
+
+    default:
+      goto bad_1;		/* :::::::::::::::::::: */
+    }
+
+bad_0:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTAINS", ffesta_tokens[0]);
+  return (ffelexHandler) ffelex_swallow_tokens (t,
+						(ffelexHandler) ffesta_zero);	/* Invalid first token. */
+
+bad_1:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTAINS", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t,
+						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
+
+bad_i:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CONTAINS", ffesta_tokens[0], i, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_V009 -- Parse the UNION statement
+
+   return ffestb_V009;	// to lexer
+
+   Make sure the statement has a valid form for the UNION statement.  If
+   it does, implement the statement.  */
+
+#if FFESTR_VXT
+ffelexHandler
+ffestb_V009 (ffelexToken t)
+{
+  char *p;
+  ffeTokenLength i;
+
+  switch (ffelex_token_type (ffesta_tokens[0]))
+    {
+    case FFELEX_typeNAME:
+      if (ffesta_first_kw != FFESTR_firstUNION)
+	goto bad_0;		/* :::::::::::::::::::: */
+      break;
+
+    case FFELEX_typeNAMES:
+      if (ffesta_first_kw != FFESTR_firstUNION)
+	goto bad_0;		/* :::::::::::::::::::: */
+      if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlUNION)
+	{
+	  p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlUNION);
+	  goto bad_i;		/* :::::::::::::::::::: */
+	}
+      break;
+
+    default:
+      goto bad_0;		/* :::::::::::::::::::: */
+    }
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      ffesta_confirmed ();
+      if (!ffesta_is_inhibited ())
+	ffestc_V009 ();
+      return (ffelexHandler) ffesta_zero (t);
+
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeCOLONCOLON:
+      ffesta_confirmed ();	/* Error, but clearly intended. */
+      goto bad_1;		/* :::::::::::::::::::: */
+
+    default:
+      goto bad_1;		/* :::::::::::::::::::: */
+    }
+
+bad_0:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "UNION", ffesta_tokens[0]);
+  return (ffelexHandler) ffelex_swallow_tokens (t,
+						(ffelexHandler) ffesta_zero);	/* Invalid first token. */
+
+bad_1:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "UNION", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t,
+						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
+
+bad_i:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "UNION", ffesta_tokens[0], i, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_construct -- Parse a construct name
+
+   return ffestb_construct;  // to lexer
+
+   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_heap -- Parse an ALLOCATE/DEALLOCATE statement
+
+   return ffestb_heap;	// to lexer
+
+   Make sure the statement has a valid form for an ALLOCATE/DEALLOCATE
+   statement.  If it does, implement the statement.  */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_heap (ffelexToken t)
+{
+  switch (ffelex_token_type (ffesta_tokens[0]))
+    {
+    case FFELEX_typeNAME:
+      break;
+
+    case FFELEX_typeNAMES:
+      if (ffelex_token_length (ffesta_tokens[0]) != ffestb_args.heap.len)
+	goto bad_0;		/* :::::::::::::::::::: */
+      break;
+
+    default:
+      goto bad_0;		/* :::::::::::::::::::: */
+    }
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeOPEN_PAREN:
+      break;
+
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeCOLONCOLON:
+      ffesta_confirmed ();	/* Error, but clearly intended. */
+      goto bad_1;		/* :::::::::::::::::::: */
+
+    default:
+      goto bad_1;		/* :::::::::::::::::::: */
+    }
+
+  ffestb_local_.heap.exprs = ffestt_exprlist_create ();
+  return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+				      ffestb_args.heap.ctx,
+				      (ffeexprCallback) ffestb_heap1_);
+
+bad_0:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, ffesta_tokens[0]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t,
+						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
+}
+
+/* ffestb_heap1_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN expr
+
+   (ffestb_heap1_)  // to expression handler
+
+   Make sure the next token is COMMA.  */
+
+static ffelexHandler
+ffestb_heap1_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+      if (expr == NULL)
+	break;
+      ffestt_exprlist_append (ffestb_local_.heap.exprs, expr,
+			      ffelex_token_use (t));
+      return (ffelexHandler) ffestb_heap2_;
+
+    case FFELEX_typeCLOSE_PAREN:
+      if (expr == NULL)
+	break;
+      ffestt_exprlist_append (ffestb_local_.heap.exprs, expr,
+			      ffelex_token_use (t));
+      ffesta_tokens[1] = NULL;
+      ffestb_local_.heap.expr = NULL;
+      return (ffelexHandler) ffestb_heap5_;
+
+    default:
+      break;
+    }
+
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
+  ffestt_exprlist_kill (ffestb_local_.heap.exprs);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_heap2_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN expr COMMA
+
+   return ffestb_heap2_;  // to lexer
+
+   Make sure the next token is NAME.  */
+
+static ffelexHandler
+ffestb_heap2_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      ffesta_tokens[1] = ffelex_token_use (t);
+      return (ffelexHandler) ffestb_heap3_;
+
+    default:
+      break;
+    }
+
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
+  ffestt_exprlist_kill (ffestb_local_.heap.exprs);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_heap3_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN expr COMMA NAME
+
+   return ffestb_heap3_;  // to lexer
+
+   If token is EQUALS, make sure NAME was "STAT" and handle STAT variable;
+   else pass NAME and token to expression handler.  */
+
+static ffelexHandler
+ffestb_heap3_ (ffelexToken t)
+{
+  ffelexHandler next;
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEQUALS:
+      ffesta_confirmed ();
+      if (ffestr_other (ffesta_tokens[1]) != FFESTR_otherSTAT)
+	break;
+      ffelex_token_kill (ffesta_tokens[1]);
+      return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+					  FFEEXPR_contextHEAPSTAT,
+					  (ffeexprCallback) ffestb_heap4_);
+
+    default:
+      next = (ffelexHandler)
+	(*((ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+					ffestb_args.heap.ctx,
+					(ffeexprCallback) ffestb_heap1_)))
+	(ffesta_tokens[1]);
+      ffelex_token_kill (ffesta_tokens[1]);
+      return (ffelexHandler) (*next) (t);
+    }
+
+  ffelex_token_kill (ffesta_tokens[1]);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
+  ffestt_exprlist_kill (ffestb_local_.heap.exprs);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_heap4_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN ... COMMA "STAT" EQUALS
+		    expr
+
+   (ffestb_heap4_)  // to expression handler
+
+   Make sure the next token is CLOSE_PAREN.  */
+
+static ffelexHandler
+ffestb_heap4_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCLOSE_PAREN:
+      if (expr == NULL)
+	break;
+      ffesta_tokens[1] = ffelex_token_use (ft);
+      ffestb_local_.heap.expr = expr;
+      return (ffelexHandler) ffestb_heap5_;
+
+    default:
+      break;
+    }
+
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
+  ffestt_exprlist_kill (ffestb_local_.heap.exprs);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_heap5_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN ... CLOSE_PAREN
+
+   return ffestb_heap5_;  // to lexer
+
+   Make sure the next token is EOS/SEMICOLON.  */
+
+static ffelexHandler
+ffestb_heap5_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      ffesta_confirmed ();
+      if (!ffesta_is_inhibited ())
+	if (ffesta_first_kw == FFESTR_firstALLOCATE)
+	  ffestc_R620 (ffestb_local_.heap.exprs, ffestb_local_.heap.expr,
+		       ffesta_tokens[1]);
+	else
+	  ffestc_R625 (ffestb_local_.heap.exprs, ffestb_local_.heap.expr,
+		       ffesta_tokens[1]);
+      ffestt_exprlist_kill (ffestb_local_.heap.exprs);
+      if (ffesta_tokens[1] != NULL)
+	ffelex_token_kill (ffesta_tokens[1]);
+      return (ffelexHandler) ffesta_zero (t);
+
+    default:
+      break;
+    }
+
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
+  ffestt_exprlist_kill (ffestb_local_.heap.exprs);
+  if (ffesta_tokens[1] != NULL)
+    ffelex_token_kill (ffesta_tokens[1]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_module -- Parse the MODULEPROCEDURE statement
+
+   return ffestb_module;  // to lexer
+
+   Make sure the statement has a valid form for the MODULEPROCEDURE statement.
+   If it does, implement the statement.
+
+   31-May-90  JCB  1.1
+      Confirm NAME==MODULE followed by standard four invalid tokens, so we
+      get decent message if somebody forgets that MODULE requires a name.  */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_module (ffelexToken t)
+{
+  ffeTokenLength i;
+  char *p;
+  ffelexToken nt;
+  ffelexToken mt;		/* Name in MODULE PROCEDUREname, i.e.
+				   includes "PROCEDURE". */
+
+  switch (ffelex_token_type (ffesta_tokens[0]))
+    {
+    case FFELEX_typeNAME:
+      if (ffesta_first_kw != FFESTR_firstMODULE)
+	goto bad_0;		/* :::::::::::::::::::: */
+      switch (ffelex_token_type (t))
+	{
+	case FFELEX_typeNAME:
+	  break;
+
+	case FFELEX_typeCOLONCOLON:
+	case FFELEX_typeCOMMA:
+	case FFELEX_typeEOS:
+	case FFELEX_typeSEMICOLON:
+	  ffesta_confirmed ();
+	  goto bad_1m;		/* :::::::::::::::::::: */
+
+	default:
+	  goto bad_1m;		/* :::::::::::::::::::: */
+	}
+
+      ffesta_confirmed ();
+      if (ffesta_second_kw != FFESTR_secondPROCEDURE)
+	{
+	  ffesta_tokens[1] = ffelex_token_use (t);
+	  return (ffelexHandler) ffestb_module3_;
+	}
+      ffestb_local_.moduleprocedure.started = FALSE;
+      ffesta_tokens[1] = ffelex_token_use (t);
+      return (ffelexHandler) ffestb_module1_;
+
+    case FFELEX_typeNAMES:
+      p = ffelex_token_text (ffesta_tokens[0])
+	+ (i = FFESTR_firstlMODULEPROCEDURE);
+      if ((ffesta_first_kw == FFESTR_firstMODULE)
+	  || ((ffesta_first_kw == FFESTR_firstMODULEPROCEDURE)
+	      && !ffesrc_is_name_init (*p)))
+	{			/* Definitely not "MODULE PROCEDURE name". */
+	  switch (ffelex_token_type (t))
+	    {
+	    case FFELEX_typeCOMMA:
+	    case FFELEX_typeCOLONCOLON:
+	      ffesta_confirmed ();	/* Error, but clearly intended. */
+	      goto bad_1m;	/* :::::::::::::::::::: */
+
+	    default:
+	      goto bad_1m;	/* :::::::::::::::::::: */
+
+	    case FFELEX_typeEOS:
+	    case FFELEX_typeSEMICOLON:
+	      ffesta_confirmed ();
+	      break;
+	    }
+	  p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlMODULE);
+	  if (!ffesrc_is_name_init (*p))
+	    goto bad_im;	/* :::::::::::::::::::: */
+	  nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+	  if (!ffesta_is_inhibited ())
+	    ffestc_R1105 (nt);
+	  ffelex_token_kill (nt);
+	  return (ffelexHandler) ffesta_zero (t);
+	}
+
+      /* Here we know that we're indeed looking at a MODULEPROCEDURE
+	 statement rather than MODULE and that the character following
+	 MODULEPROCEDURE in the NAMES token is a valid first character for a
+	 NAME.	This means that unless the second token is COMMA, we have an
+	 ambiguous statement that can be read either as MODULE PROCEDURE name
+	 or MODULE PROCEDUREname, the former being an R1205, the latter an
+	 R1105. */
+
+      if (ffesta_first_kw != FFESTR_firstMODULEPROCEDURE)
+	goto bad_0;		/* :::::::::::::::::::: */
+      switch (ffelex_token_type (t))
+	{
+	case FFELEX_typeCOLONCOLON:
+	  ffesta_confirmed ();	/* Error, but clearly intended. */
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	default:
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	case FFELEX_typeCOMMA:	/* Aha, clearly not MODULE PROCEDUREname. */
+	  ffesta_confirmed ();
+	  ffestb_local_.moduleprocedure.started = FALSE;
+	  ffesta_tokens[1]
+	    = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+	  return (ffelexHandler) ffestb_module2_ (t);
+
+	case FFELEX_typeEOS:	/* MODULE PROCEDURE name or MODULE
+				   PROCEDUREname. */
+	case FFELEX_typeSEMICOLON:
+	  ffesta_confirmed ();
+	  break;
+	}
+      nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+      mt = ffelex_token_name_from_names (ffesta_tokens[0], FFESTR_firstlMODULE,
+					 0);
+      if (!ffesta_is_inhibited ())
+	ffestc_module (mt, nt);	/* Implement ambiguous statement. */
+      ffelex_token_kill (nt);
+      ffelex_token_kill (mt);
+      return (ffelexHandler) ffesta_zero (t);
+
+    default:
+      goto bad_0;		/* :::::::::::::::::::: */
+    }
+
+bad_0:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", ffesta_tokens[0]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t,
+						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
+
+bad_1m:			/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t,
+						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
+
+bad_im:			/* :::::::::::::::::::: */
+  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "MODULE", ffesta_tokens[0], i, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_module1_ -- "MODULEPROCEDURE" or "MODULE" "PROCEDURE"
+
+   return ffestb_module1_;  // to lexer
+
+   Make sure the statement has a valid form for the MODULEPROCEDURE statement.	If it
+   does, implement the statement.  */
+
+static ffelexHandler
+ffestb_module1_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      if (!ffestb_local_.moduleprocedure.started
+	  && (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME))
+	{
+	  ffesta_confirmed ();
+	  ffelex_token_kill (ffesta_tokens[1]);
+	}
+      ffesta_tokens[1] = ffelex_token_use (t);
+      return (ffelexHandler) ffestb_module2_;
+
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      if (ffestb_local_.moduleprocedure.started)
+	break;			/* Error if we've already seen NAME COMMA. */
+      ffesta_confirmed ();
+      if (!ffesta_is_inhibited ())
+	ffestc_R1105 (ffesta_tokens[1]);
+      ffelex_token_kill (ffesta_tokens[1]);
+      return (ffelexHandler) ffesta_zero (t);
+
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeCOLONCOLON:
+      ffesta_confirmed ();	/* Error, but clearly intended. */
+      break;
+
+    default:
+      break;
+    }
+
+  if (ffestb_local_.moduleprocedure.started && !ffesta_is_inhibited ())
+    ffestc_R1205_finish ();
+  else if (!ffestb_local_.moduleprocedure.started)
+    ffelex_token_kill (ffesta_tokens[1]);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_module2_ -- "MODULE/PROCEDURE" NAME
+
+   return ffestb_module2_;  // to lexer
+
+   Make sure the statement has a valid form for the MODULEPROCEDURE statement.	If it
+   does, implement the statement.  */
+
+static ffelexHandler
+ffestb_module2_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      if (!ffestb_local_.moduleprocedure.started)
+	{
+	  ffesta_confirmed ();
+	  if (!ffesta_is_inhibited ())
+	    ffestc_R1205_start ();
+	}
+      if (!ffesta_is_inhibited ())
+	{
+	  ffestc_R1205_item (ffesta_tokens[1]);
+	  ffestc_R1205_finish ();
+	}
+      ffelex_token_kill (ffesta_tokens[1]);
+      return (ffelexHandler) ffesta_zero (t);
+
+    case FFELEX_typeCOMMA:
+      if (!ffestb_local_.moduleprocedure.started)
+	{
+	  ffestb_local_.moduleprocedure.started = TRUE;
+	  ffesta_confirmed ();
+	  if (!ffesta_is_inhibited ())
+	    ffestc_R1205_start ();
+	}
+      if (!ffesta_is_inhibited ())
+	ffestc_R1205_item (ffesta_tokens[1]);
+      ffelex_token_kill (ffesta_tokens[1]);
+      return (ffelexHandler) ffestb_module1_;
+
+    default:
+      break;
+    }
+
+  if (ffestb_local_.moduleprocedure.started && !ffesta_is_inhibited ())
+    ffestc_R1205_finish ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", t);
+  ffelex_token_kill (ffesta_tokens[1]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_module3_ -- "MODULE" NAME
+
+   return ffestb_module3_;  // to lexer
+
+   Make sure the statement has a valid form for the MODULE statement.  If it
+   does, implement the statement.  */
+
+static ffelexHandler
+ffestb_module3_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      if (!ffesta_is_inhibited ())
+	ffestc_R1105 (ffesta_tokens[1]);
+      ffelex_token_kill (ffesta_tokens[1]);
+      return (ffelexHandler) ffesta_zero (t);
+
+    default:
+      break;
+    }
+
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE", t);
+  ffelex_token_kill (ffesta_tokens[1]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_R809 -- Parse the SELECTCASE statement
+
+   return ffestb_R809;	// to lexer
+
+   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;
+  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;
+  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;
+  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 = 0; i < ffelex_token_length (t); ++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 = 0; i < ffelex_token_length (t); ++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 (*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;
+  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 = 0; i < ffelex_token_length (t); ++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;
+  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 = 0; i < ffelex_token_length (t); ++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 = 0; i < ffelex_token_length (t); ++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 = required;
+	  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 (FALSE);
+	  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_R1107 -- Parse the USE statement
+
+   return ffestb_R1107;	 // to lexer
+
+   Make sure the statement has a valid form for the USE statement.
+   If it does, implement the statement.	 */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_R1107 (ffelexToken t)
+{
+  ffeTokenLength i;
+  char *p;
+
+  switch (ffelex_token_type (ffesta_tokens[0]))
+    {
+    case FFELEX_typeNAME:
+      if (ffesta_first_kw != FFESTR_firstUSE)
+	goto bad_0;		/* :::::::::::::::::::: */
+      switch (ffelex_token_type (t))
+	{
+	case FFELEX_typeNAME:
+	  break;
+
+	case FFELEX_typeEOS:
+	case FFELEX_typeSEMICOLON:
+	case FFELEX_typeCOMMA:
+	case FFELEX_typeCOLONCOLON:
+	  ffesta_confirmed ();	/* Error, but clearly intended. */
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	default:
+	  goto bad_0;		/* :::::::::::::::::::: */
+	}
+      ffesta_confirmed ();
+      ffesta_tokens[1] = ffelex_token_use (t);
+      return (ffelexHandler) ffestb_R11071_;
+
+    case FFELEX_typeNAMES:
+      if (ffesta_first_kw != FFESTR_firstUSE)
+	goto bad_0;		/* :::::::::::::::::::: */
+      p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlUSE);
+      if (!ffesrc_is_name_init (*p))
+	goto bad_i;		/* :::::::::::::::::::: */
+      switch (ffelex_token_type (t))
+	{
+	case FFELEX_typeCOLONCOLON:
+	  ffesta_confirmed ();	/* Error, but clearly intended. */
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	default:
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	case FFELEX_typeCOMMA:
+	case FFELEX_typeEOS:
+	case FFELEX_typeSEMICOLON:
+	  break;
+	}
+      ffesta_confirmed ();
+      ffesta_tokens[1]
+	= ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+      return (ffelexHandler) ffestb_R11071_ (t);
+
+    default:
+      goto bad_0;		/* :::::::::::::::::::: */
+    }
+
+bad_0:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", ffesta_tokens[0]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t,
+						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
+
+bad_i:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "USE", ffesta_tokens[0], i, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11071_ -- "USE" NAME
+
+   return ffestb_R11071_;  // to lexer
+
+   Make sure the statement has a valid form for the USE statement.  If it
+   does, implement the statement.  */
+
+static ffelexHandler
+ffestb_R11071_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      if (!ffesta_is_inhibited ())
+	{
+	  ffestc_R1107_start (ffesta_tokens[1], FALSE);
+	  ffestc_R1107_finish ();
+	}
+      ffelex_token_kill (ffesta_tokens[1]);
+      return (ffelexHandler) ffesta_zero (t);
+
+    case FFELEX_typeCOMMA:
+      return (ffelexHandler) ffestb_R11072_;
+
+    default:
+      break;
+    }
+
+  ffelex_token_kill (ffesta_tokens[1]);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11072_ -- "USE" NAME COMMA
+
+   return ffestb_R11072_;  // to lexer
+
+   Make sure the statement has a valid form for the USE statement.  If it
+   does, implement the statement.  */
+
+static ffelexHandler
+ffestb_R11072_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      ffesta_tokens[2] = ffelex_token_use (t);
+      return (ffelexHandler) ffestb_R11073_;
+
+    default:
+      break;
+    }
+
+  ffelex_token_kill (ffesta_tokens[1]);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11073_ -- "USE" NAME COMMA NAME
+
+   return ffestb_R11073_;  // to lexer
+
+   Make sure the statement has a valid form for the USE statement.  If it
+   does, implement the statement.  */
+
+static ffelexHandler
+ffestb_R11073_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOLON:
+      if (ffestr_other (ffesta_tokens[2]) != FFESTR_otherONLY)
+	break;
+      if (!ffesta_is_inhibited ())
+	ffestc_R1107_start (ffesta_tokens[1], TRUE);
+      ffelex_token_kill (ffesta_tokens[1]);
+      ffelex_token_kill (ffesta_tokens[2]);
+      return (ffelexHandler) ffestb_R11074_;
+
+    case FFELEX_typePOINTS:
+      if (!ffesta_is_inhibited ())
+	ffestc_R1107_start (ffesta_tokens[1], FALSE);
+      ffelex_token_kill (ffesta_tokens[1]);
+      ffesta_tokens[1] = ffesta_tokens[2];
+      return (ffelexHandler) ffestb_R110711_;
+
+    default:
+      break;
+    }
+
+  ffelex_token_kill (ffesta_tokens[1]);
+  ffelex_token_kill (ffesta_tokens[2]);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11074_ -- "USE" NAME COMMA "ONLY" COLON
+
+   return ffestb_R11074_;  // to lexer
+
+   Make sure the statement has a valid form for the USE statement.  If it
+   does, implement the statement.  */
+
+static ffelexHandler
+ffestb_R11074_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      ffesta_tokens[1] = ffelex_token_use (t);
+      return (ffelexHandler) ffestb_R11075_;
+
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      if (!ffesta_is_inhibited ())
+	ffestc_R1107_finish ();
+      return (ffelexHandler) ffesta_zero (t);
+
+    default:
+      break;
+    }
+
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+  ffestc_R1107_finish ();
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11075_ -- "USE" NAME COMMA "ONLY" COLON NAME
+
+   return ffestb_R11075_;  // to lexer
+
+   Make sure the statement has a valid form for the USE statement.  If it
+   does, implement the statement.  */
+
+static ffelexHandler
+ffestb_R11075_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      if (!ffesta_is_inhibited ())
+	{
+	  ffestc_R1107_item (NULL, ffesta_tokens[1]);
+	  ffestc_R1107_finish ();
+	}
+      ffelex_token_kill (ffesta_tokens[1]);
+      return (ffelexHandler) ffesta_zero (t);
+
+    case FFELEX_typeCOMMA:
+      if (!ffesta_is_inhibited ())
+	ffestc_R1107_item (NULL, ffesta_tokens[1]);
+      ffelex_token_kill (ffesta_tokens[1]);
+      return (ffelexHandler) ffestb_R11078_;
+
+    case FFELEX_typePOINTS:
+      return (ffelexHandler) ffestb_R11076_;
+
+    default:
+      break;
+    }
+
+  ffelex_token_kill (ffesta_tokens[1]);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+  ffestc_R1107_finish ();
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11076_ -- "USE" NAME COMMA "ONLY" COLON NAME POINTS
+
+   return ffestb_R11076_;  // to lexer
+
+   Make sure the statement has a valid form for the USE statement.  If it
+   does, implement the statement.  */
+
+static ffelexHandler
+ffestb_R11076_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      if (!ffesta_is_inhibited ())
+	ffestc_R1107_item (ffesta_tokens[1], t);
+      ffelex_token_kill (ffesta_tokens[1]);
+      return (ffelexHandler) ffestb_R11077_;
+
+    default:
+      break;
+    }
+
+  ffelex_token_kill (ffesta_tokens[1]);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+  ffestc_R1107_finish ();
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11077_ -- "USE" NAME COMMA "ONLY" COLON NAME POINTS NAME
+
+   return ffestb_R11077_;  // to lexer
+
+   Make sure the statement has a valid form for the USE statement.  If it
+   does, implement the statement.  */
+
+static ffelexHandler
+ffestb_R11077_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      if (!ffesta_is_inhibited ())
+	ffestc_R1107_finish ();
+      return (ffelexHandler) ffesta_zero (t);
+
+    case FFELEX_typeCOMMA:
+      return (ffelexHandler) ffestb_R11078_;
+
+    default:
+      break;
+    }
+
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+  ffestc_R1107_finish ();
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11078_ -- "USE" NAME COMMA "ONLY" COLON NAME POINTS NAME COMMA
+
+   return ffestb_R11078_;  // to lexer
+
+   Make sure the statement has a valid form for the USE statement.  If it
+   does, implement the statement.  */
+
+static ffelexHandler
+ffestb_R11078_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      ffesta_tokens[1] = ffelex_token_use (t);
+      return (ffelexHandler) ffestb_R11075_;
+
+    default:
+      break;
+    }
+
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+  ffestc_R1107_finish ();
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11079_ -- "USE" NAME COMMA
+
+   return ffestb_R11079_;  // to lexer
+
+   Make sure the statement has a valid form for the USE statement.  If it
+   does, implement the statement.  */
+
+static ffelexHandler
+ffestb_R11079_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      ffesta_tokens[1] = ffelex_token_use (t);
+      return (ffelexHandler) ffestb_R110710_;
+
+    default:
+      break;
+    }
+
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+  ffestc_R1107_finish ();
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R110710_ -- "USE" NAME COMMA NAME
+
+   return ffestb_R110710_;  // to lexer
+
+   Make sure the statement has a valid form for the USE statement.  If it
+   does, implement the statement.  */
+
+static ffelexHandler
+ffestb_R110710_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typePOINTS:
+      return (ffelexHandler) ffestb_R110711_;
+
+    default:
+      break;
+    }
+
+  ffelex_token_kill (ffesta_tokens[1]);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+  ffestc_R1107_finish ();
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R110711_ -- "USE" NAME COMMA NAME POINTS
+
+   return ffestb_R110711_;  // to lexer
+
+   Make sure the statement has a valid form for the USE statement.  If it
+   does, implement the statement.  */
+
+static ffelexHandler
+ffestb_R110711_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      if (!ffesta_is_inhibited ())
+	ffestc_R1107_item (ffesta_tokens[1], t);
+      ffelex_token_kill (ffesta_tokens[1]);
+      return (ffelexHandler) ffestb_R110712_;
+
+    default:
+      break;
+    }
+
+  ffelex_token_kill (ffesta_tokens[1]);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+  ffestc_R1107_finish ();
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R110712_ -- "USE" NAME COMMA NAME POINTS NAME
+
+   return ffestb_R110712_;  // to lexer
+
+   Make sure the statement has a valid form for the USE statement.  If it
+   does, implement the statement.  */
+
+static ffelexHandler
+ffestb_R110712_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      if (!ffesta_is_inhibited ())
+	ffestc_R1107_finish ();
+      return (ffelexHandler) ffesta_zero (t);
+
+    case FFELEX_typeCOMMA:
+      return (ffelexHandler) ffestb_R11079_;
+
+    default:
+      break;
+    }
+
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+  ffestc_R1107_finish ();
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_R1202 -- Parse the INTERFACE statement
+
+   return ffestb_R1202;	 // to lexer
+
+   Make sure the statement has a valid form for the INTERFACE statement.
+   If it does, implement the statement.
+
+   15-May-90  JCB  1.1
+      Allow INTERFACE by itself; missed this
+      valid form when originally doing syntactic analysis code.	 */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_R1202 (ffelexToken t)
+{
+  ffeTokenLength i;
+  char *p;
+
+  switch (ffelex_token_type (ffesta_tokens[0]))
+    {
+    case FFELEX_typeNAME:
+      if (ffesta_first_kw != FFESTR_firstINTERFACE)
+	goto bad_0;		/* :::::::::::::::::::: */
+      switch (ffelex_token_type (t))
+	{
+	case FFELEX_typeNAME:
+	  break;
+
+	case FFELEX_typeEOS:
+	case FFELEX_typeSEMICOLON:
+	  ffesta_confirmed ();
+	  if (!ffesta_is_inhibited ())
+	    ffestc_R1202 (FFESTP_definedoperatorNone, NULL);
+	  return (ffelexHandler) ffesta_zero (t);
+
+	case FFELEX_typeCOMMA:
+	case FFELEX_typeCOLONCOLON:
+	  ffesta_confirmed ();	/* Error, but clearly intended. */
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	default:
+	  goto bad_1;		/* :::::::::::::::::::: */
+	}
+
+      ffesta_confirmed ();
+      switch (ffesta_second_kw)
+	{
+	case FFESTR_secondOPERATOR:
+	  ffestb_local_.interface.operator = FFESTP_definedoperatorOPERATOR;
+	  break;
+
+	case FFESTR_secondASSIGNMENT:
+	  ffestb_local_.interface.operator = FFESTP_definedoperatorASSIGNMENT;
+	  break;
+
+	default:
+	  ffestb_local_.interface.operator = FFESTP_definedoperatorNone;
+	  break;
+	}
+      ffesta_tokens[1] = ffelex_token_use (t);
+      return (ffelexHandler) ffestb_R12021_;
+
+    case FFELEX_typeNAMES:
+      p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlINTERFACE);
+      switch (ffesta_first_kw)
+	{
+	case FFESTR_firstINTERFACEOPERATOR:
+	  if (*(ffelex_token_text (ffesta_tokens[0])
+		+ FFESTR_firstlINTERFACEOPERATOR) == '\0')
+	    ffestb_local_.interface.operator
+	      = FFESTP_definedoperatorOPERATOR;
+	  break;
+
+	case FFESTR_firstINTERFACEASSGNMNT:
+	  if (*(ffelex_token_text (ffesta_tokens[0])
+		+ FFESTR_firstlINTERFACEASSGNMNT) == '\0')
+	    ffestb_local_.interface.operator
+	      = FFESTP_definedoperatorASSIGNMENT;
+	  break;
+
+	case FFESTR_firstINTERFACE:
+	  ffestb_local_.interface.operator = FFESTP_definedoperatorNone;
+	  break;
+
+	default:
+	  goto bad_0;		/* :::::::::::::::::::: */
+	}
+      switch (ffelex_token_type (t))
+	{
+	case FFELEX_typeCOMMA:
+	case FFELEX_typeCOLONCOLON:
+	  ffesta_confirmed ();	/* Error, but clearly intended. */
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	default:
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	case FFELEX_typeOPEN_PAREN:
+	case FFELEX_typeOPEN_ARRAY:	/* Sigh. */
+	  break;
+
+	case FFELEX_typeEOS:
+	case FFELEX_typeSEMICOLON:
+	  ffesta_confirmed ();
+	  if (*p == '\0')
+	    {
+	      if (!ffesta_is_inhibited ())
+		ffestc_R1202 (FFESTP_definedoperatorNone, NULL);
+	      return (ffelexHandler) ffesta_zero (t);
+	    }
+	  break;
+	}
+      if (!ffesrc_is_name_init (*p))
+	goto bad_i;		/* :::::::::::::::::::: */
+      ffesta_tokens[1] = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+      return (ffelexHandler) ffestb_R12021_ (t);
+
+    default:
+      goto bad_0;		/* :::::::::::::::::::: */
+    }
+
+bad_0:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", ffesta_tokens[0]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t,
+						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
+
+bad_i:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "INTERFACE", ffesta_tokens[0], i, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R12021_ -- "INTERFACE" NAME
+
+   return ffestb_R12021_;  // to lexer
+
+   Make sure the statement has a valid form for the INTERFACE statement.  If
+   it does, implement the statement.  */
+
+static ffelexHandler
+ffestb_R12021_ (ffelexToken t)
+{
+  ffestb_local_.interface.slash = TRUE;	/* Slash follows open paren. */
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      if (!ffesta_is_inhibited ())
+	ffestc_R1202 (FFESTP_definedoperatorNone, ffesta_tokens[1]);
+      ffelex_token_kill (ffesta_tokens[1]);
+      return (ffelexHandler) ffesta_zero (t);
+
+    case FFELEX_typeOPEN_PAREN:
+      ffestb_local_.interface.slash = FALSE;	/* Slash doesn't follow. */
+      /* Fall through. */
+    case FFELEX_typeOPEN_ARRAY:
+      switch (ffestb_local_.interface.operator)
+	{
+	case FFESTP_definedoperatorNone:
+	  break;
+
+	case FFESTP_definedoperatorOPERATOR:
+	  ffestb_local_.interface.assignment = FALSE;
+	  return (ffelexHandler) ffestb_R12022_;
+
+	case FFESTP_definedoperatorASSIGNMENT:
+	  ffestb_local_.interface.assignment = TRUE;
+	  return (ffelexHandler) ffestb_R12022_;
+
+	default:
+	  assert (FALSE);
+	}
+      break;
+
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeCOLONCOLON:
+      ffesta_confirmed ();	/* Error, but clearly intended. */
+      break;
+
+    default:
+      break;
+    }
+
+  ffelex_token_kill (ffesta_tokens[1]);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R12022_ -- "INTERFACE" "OPERATOR/ASSIGNMENT" OPEN_PAREN
+
+   return ffestb_R12022_;  // to lexer
+
+   Make sure the statement has a valid form for the INTERFACE statement.  If
+   it does, implement the statement.  */
+
+static ffelexHandler
+ffestb_R12022_ (ffelexToken t)
+{
+  ffesta_tokens[2] = ffelex_token_use (t);
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typePERIOD:
+      if (ffestb_local_.interface.slash)
+	break;
+      return (ffelexHandler) ffestb_R12023_;
+
+    case FFELEX_typePOWER:
+      if (ffestb_local_.interface.slash)
+	break;
+      ffestb_local_.interface.operator = FFESTP_definedoperatorPOWER;
+      return (ffelexHandler) ffestb_R12025_;
+
+    case FFELEX_typeASTERISK:
+      if (ffestb_local_.interface.slash)
+	break;
+      ffestb_local_.interface.operator = FFESTP_definedoperatorMULT;
+      return (ffelexHandler) ffestb_R12025_;
+
+    case FFELEX_typePLUS:
+      if (ffestb_local_.interface.slash)
+	break;
+      ffestb_local_.interface.operator = FFESTP_definedoperatorADD;
+      return (ffelexHandler) ffestb_R12025_;
+
+    case FFELEX_typeCONCAT:
+      if (ffestb_local_.interface.slash)
+	break;
+      ffestb_local_.interface.operator = FFESTP_definedoperatorCONCAT;
+      return (ffelexHandler) ffestb_R12025_;
+
+    case FFELEX_typeSLASH:
+      if (ffestb_local_.interface.slash)
+	{
+	  ffestb_local_.interface.operator = FFESTP_definedoperatorCONCAT;
+	  return (ffelexHandler) ffestb_R12025_;
+	}
+      ffestb_local_.interface.operator = FFESTP_definedoperatorDIVIDE;
+      return (ffelexHandler) ffestb_R12025_;
+
+    case FFELEX_typeMINUS:
+      if (ffestb_local_.interface.slash)
+	break;
+      ffestb_local_.interface.operator = FFESTP_definedoperatorSUBTRACT;
+      return (ffelexHandler) ffestb_R12025_;
+
+    case FFELEX_typeREL_EQ:
+      if (ffestb_local_.interface.slash)
+	break;
+      ffestb_local_.interface.operator = FFESTP_definedoperatorEQ;
+      return (ffelexHandler) ffestb_R12025_;
+
+    case FFELEX_typeREL_NE:
+      if (ffestb_local_.interface.slash)
+	break;
+      ffestb_local_.interface.operator = FFESTP_definedoperatorNE;
+      return (ffelexHandler) ffestb_R12025_;
+
+    case FFELEX_typeOPEN_ANGLE:
+      if (ffestb_local_.interface.slash)
+	break;
+      ffestb_local_.interface.operator = FFESTP_definedoperatorLT;
+      return (ffelexHandler) ffestb_R12025_;
+
+    case FFELEX_typeREL_LE:
+      if (ffestb_local_.interface.slash)
+	break;
+      ffestb_local_.interface.operator = FFESTP_definedoperatorLE;
+      return (ffelexHandler) ffestb_R12025_;
+
+    case FFELEX_typeCLOSE_ANGLE:
+      if (ffestb_local_.interface.slash)
+	break;
+      ffestb_local_.interface.operator = FFESTP_definedoperatorGT;
+      return (ffelexHandler) ffestb_R12025_;
+
+    case FFELEX_typeREL_GE:
+      if (ffestb_local_.interface.slash)
+	break;
+      ffestb_local_.interface.operator = FFESTP_definedoperatorGE;
+      return (ffelexHandler) ffestb_R12025_;
+
+    case FFELEX_typeEQUALS:
+      if (ffestb_local_.interface.slash)
+	{
+	  ffestb_local_.interface.operator = FFESTP_definedoperatorNE;
+	  return (ffelexHandler) ffestb_R12025_;
+	}
+      ffestb_local_.interface.operator = FFESTP_definedoperatorASSIGNMENT;
+      return (ffelexHandler) ffestb_R12025_;
+
+    case FFELEX_typeCLOSE_ARRAY:
+      if (!ffestb_local_.interface.slash)
+	{
+	  ffestb_local_.interface.operator = FFESTP_definedoperatorDIVIDE;
+	  return (ffelexHandler) ffestb_R12026_;
+	}
+      ffestb_local_.interface.operator = FFESTP_definedoperatorCONCAT;
+      return (ffelexHandler) ffestb_R12026_;
+
+    case FFELEX_typeCLOSE_PAREN:
+      if (!ffestb_local_.interface.slash)
+	break;
+      ffestb_local_.interface.operator = FFESTP_definedoperatorDIVIDE;
+      return (ffelexHandler) ffestb_R12026_;
+
+    default:
+      break;
+    }
+
+  ffelex_token_kill (ffesta_tokens[1]);
+  ffelex_token_kill (ffesta_tokens[2]);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R12023_ -- "INTERFACE" NAME OPEN_PAREN PERIOD
+
+   return ffestb_R12023_;  // to lexer
+
+   Make sure the statement has a valid form for the INTERFACE statement.  If
+   it does, implement the statement.  */
+
+static ffelexHandler
+ffestb_R12023_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      ffelex_token_kill (ffesta_tokens[2]);
+      ffesta_tokens[2] = ffelex_token_use (t);
+      return (ffelexHandler) ffestb_R12024_;
+
+    default:
+      break;
+    }
+
+  ffelex_token_kill (ffesta_tokens[1]);
+  ffelex_token_kill (ffesta_tokens[2]);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R12024_ -- "INTERFACE" NAME OPEN_PAREN PERIOD NAME
+
+   return ffestb_R12024_;  // to lexer
+
+   Make sure the statement has a valid form for the INTERFACE statement.  If
+   it does, implement the statement.  */
+
+static ffelexHandler
+ffestb_R12024_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typePERIOD:
+      return (ffelexHandler) ffestb_R12025_;
+
+    default:
+      break;
+    }
+
+  ffelex_token_kill (ffesta_tokens[1]);
+  ffelex_token_kill (ffesta_tokens[2]);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R12025_ -- "INTERFACE" NAME OPEN_PAREN operator
+
+   return ffestb_R12025_;  // to lexer
+
+   Make sure the statement has a valid form for the INTERFACE statement.  If
+   it does, implement the statement.  */
+
+static ffelexHandler
+ffestb_R12025_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCLOSE_PAREN:
+      return (ffelexHandler) ffestb_R12026_;
+
+    default:
+      break;
+    }
+
+  ffelex_token_kill (ffesta_tokens[1]);
+  ffelex_token_kill (ffesta_tokens[2]);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R12026_ -- "INTERFACE" NAME OPEN_PAREN operator CLOSE_PAREN
+
+   return ffestb_R12026_;  // to lexer
+
+   Make sure the statement has a valid form for the INTERFACE statement.  If
+   it does, implement the statement.  */
+
+static ffelexHandler
+ffestb_R12026_ (ffelexToken t)
+{
+  char *p;
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      ffesta_confirmed ();
+      if (ffestb_local_.interface.assignment
+	  && (ffestb_local_.interface.operator
+	      != FFESTP_definedoperatorASSIGNMENT))
+	{
+	  ffebad_start (FFEBAD_INTERFACE_ASSIGNMENT);
+	  ffebad_here (0, ffelex_token_where_line (ffesta_tokens[1]),
+		       ffelex_token_where_column (ffesta_tokens[1]));
+	  ffebad_here (1, ffelex_token_where_line (ffesta_tokens[2]),
+		       ffelex_token_where_column (ffesta_tokens[2]));
+	  ffebad_finish ();
+	}
+      switch (ffelex_token_type (ffesta_tokens[2]))
+	{
+	case FFELEX_typeNAME:
+	  switch (ffestr_other (ffesta_tokens[2]))
+	    {
+	    case FFESTR_otherNOT:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R1202 (FFESTP_definedoperatorNOT, NULL);
+	      break;
+
+	    case FFESTR_otherAND:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R1202 (FFESTP_definedoperatorAND, NULL);
+	      break;
+
+	    case FFESTR_otherOR:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R1202 (FFESTP_definedoperatorOR, NULL);
+	      break;
+
+	    case FFESTR_otherEQV:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R1202 (FFESTP_definedoperatorEQV, NULL);
+	      break;
+
+	    case FFESTR_otherNEQV:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R1202 (FFESTP_definedoperatorNEQV, NULL);
+	      break;
+
+	    case FFESTR_otherEQ:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R1202 (FFESTP_definedoperatorEQ, NULL);
+	      break;
+
+	    case FFESTR_otherNE:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R1202 (FFESTP_definedoperatorNE, NULL);
+	      break;
+
+	    case FFESTR_otherLT:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R1202 (FFESTP_definedoperatorLT, NULL);
+	      break;
+
+	    case FFESTR_otherLE:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R1202 (FFESTP_definedoperatorLE, NULL);
+	      break;
+
+	    case FFESTR_otherGT:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R1202 (FFESTP_definedoperatorGT, NULL);
+	      break;
+
+	    case FFESTR_otherGE:
+	      if (!ffesta_is_inhibited ())
+		ffestc_R1202 (FFESTP_definedoperatorGE, NULL);
+	      break;
+
+	    default:
+	      for (p = ffelex_token_text (ffesta_tokens[2]); *p != '\0'; ++p)
+		{
+		  if (!isalpha (*p))
+		    {
+		      ffelex_token_kill (ffesta_tokens[1]);
+		      ffelex_token_kill (ffesta_tokens[2]);
+		      ffesta_ffebad_1t (FFEBAD_INTERFACE_NONLETTER,
+					ffesta_tokens[2]);
+		      return (ffelexHandler) ffelex_swallow_tokens (t,
+					       (ffelexHandler) ffesta_zero);
+		    }
+		}
+	      if (!ffesta_is_inhibited ())
+		ffestc_R1202 (FFESTP_definedoperatorOPERATOR,
+			      ffesta_tokens[2]);
+	    }
+	  break;
+
+	case FFELEX_typeEQUALS:
+	  if (!ffestb_local_.interface.assignment
+	      && (ffestb_local_.interface.operator
+		  == FFESTP_definedoperatorASSIGNMENT))
+	    {
+	      ffebad_start (FFEBAD_INTERFACE_OPERATOR);
+	      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[1]),
+			   ffelex_token_where_column (ffesta_tokens[1]));
+	      ffebad_here (1, ffelex_token_where_line (ffesta_tokens[2]),
+			   ffelex_token_where_column (ffesta_tokens[2]));
+	      ffebad_finish ();
+	    }
+	  if (!ffesta_is_inhibited ())
+	    ffestc_R1202 (ffestb_local_.interface.operator, NULL);
+	  break;
+
+	default:
+	  if (!ffesta_is_inhibited ())
+	    ffestc_R1202 (ffestb_local_.interface.operator, NULL);
+	}
+      ffelex_token_kill (ffesta_tokens[1]);
+      ffelex_token_kill (ffesta_tokens[2]);
+      return (ffelexHandler) ffesta_zero (t);
+
+    default:
+      break;
+    }
+
+  ffelex_token_kill (ffesta_tokens[1]);
+  ffelex_token_kill (ffesta_tokens[2]);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_S3P4 -- Parse the INCLUDE line
+
+   return ffestb_S3P4;	// to lexer
+
+   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;
+  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))
+	    {
+	      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_V012 -- Parse the MAP statement
+
+   return ffestb_V012;	// to lexer
+
+   Make sure the statement has a valid form for the MAP statement.  If
+   it does, implement the statement.  */
+
+#if FFESTR_VXT
+ffelexHandler
+ffestb_V012 (ffelexToken t)
+{
+  char *p;
+  ffeTokenLength i;
+
+  switch (ffelex_token_type (ffesta_tokens[0]))
+    {
+    case FFELEX_typeNAME:
+      if (ffesta_first_kw != FFESTR_firstMAP)
+	goto bad_0;		/* :::::::::::::::::::: */
+      break;
+
+    case FFELEX_typeNAMES:
+      if (ffesta_first_kw != FFESTR_firstMAP)
+	goto bad_0;		/* :::::::::::::::::::: */
+      if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlMAP)
+	{
+	  p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlMAP);
+	  goto bad_i;		/* :::::::::::::::::::: */
+	}
+      break;
+
+    default:
+      goto bad_0;		/* :::::::::::::::::::: */
+    }
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      ffesta_confirmed ();
+      if (!ffesta_is_inhibited ())
+	ffestc_V012 ();
+      return (ffelexHandler) ffesta_zero (t);
+
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeCOLONCOLON:
+      ffesta_confirmed ();	/* Error, but clearly intended. */
+      goto bad_1;		/* :::::::::::::::::::: */
+
+    default:
+      goto bad_1;		/* :::::::::::::::::::: */
+    }
+
+bad_0:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MAP", ffesta_tokens[0]);
+  return (ffelexHandler) ffelex_swallow_tokens (t,
+						(ffelexHandler) ffesta_zero);	/* Invalid first token. */
+
+bad_1:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MAP", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t,
+						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
+
+bad_i:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "MAP", ffesta_tokens[0], i, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_V014 -- Parse the VOLATILE statement
+
+   return ffestb_V014;	// to lexer
+
+   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;
+  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_V025 -- Parse the DEFINEFILE statement
+
+   return ffestb_V025;	// to lexer
+
+   Make sure the statement has a valid form for the DEFINEFILE statement.
+   If it does, implement the statement.	 */
+
+#if FFESTR_VXT
+ffelexHandler
+ffestb_V025 (ffelexToken t)
+{
+  ffeTokenLength i;
+  char *p;
+  ffelexToken nt;
+  ffelexHandler next;
+
+  ffestb_local_.V025.started = FALSE;
+  switch (ffelex_token_type (ffesta_tokens[0]))
+    {
+    case FFELEX_typeNAME:
+      switch (ffesta_first_kw)
+	{
+	case FFESTR_firstDEFINE:
+	  if ((ffelex_token_type (t) != FFELEX_typeNAME)
+	      || (ffesta_second_kw != FFESTR_secondFILE))
+	    goto bad_1;		/* :::::::::::::::::::: */
+	  ffesta_confirmed ();
+	  return (ffelexHandler) ffestb_V0251_;
+
+	case FFESTR_firstDEFINEFILE:
+	  return (ffelexHandler) ffestb_V0251_ (t);
+
+	default:
+	  goto bad_0;		/* :::::::::::::::::::: */
+	}
+
+    case FFELEX_typeNAMES:
+      if (ffesta_first_kw != FFESTR_firstDEFINEFILE)
+	goto bad_0;		/* :::::::::::::::::::: */
+      switch (ffelex_token_type (t))
+	{
+	case FFELEX_typeCOMMA:
+	case FFELEX_typeEOS:
+	case FFELEX_typeSEMICOLON:
+	case FFELEX_typeCOLONCOLON:
+	  ffesta_confirmed ();	/* Error, but clearly intended. */
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	default:
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	case FFELEX_typeOPEN_PAREN:
+	  break;
+	}
+      p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDEFINEFILE);
+      if (isdigit (*p))
+	nt = ffelex_token_number_from_names (ffesta_tokens[0], i);
+      else if (ffesrc_is_name_init (*p))
+	nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+      else
+	goto bad_i;		/* :::::::::::::::::::: */
+      next = (ffelexHandler) ffestb_V0251_ (nt);
+      ffelex_token_kill (nt);
+      return (ffelexHandler) (*next) (t);
+
+    default:
+      goto bad_0;		/* :::::::::::::::::::: */
+    }
+
+bad_0:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", ffesta_tokens[0]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t,
+						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
+
+bad_i:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", ffesta_tokens[0], i, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0251_ -- "DEFINEFILE" or "DEFINE" "FILE"
+
+   return ffestb_V0251_;  // to lexer
+
+   Make sure the statement has a valid form for the DEFINEFILE statement.  If it
+   does, implement the statement.  */
+
+static ffelexHandler
+ffestb_V0251_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+    case FFELEX_typeNUMBER:
+      if (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME)
+	ffesta_confirmed ();
+      return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+	      FFEEXPR_contextFILEUNIT_DF, (ffeexprCallback) ffestb_V0252_)))
+	(t);
+
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeCOLONCOLON:
+      ffesta_confirmed ();	/* Error, but clearly intended. */
+      break;
+
+    default:
+      break;
+    }
+
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0252_ -- "DEFINEFILE" expr
+
+   (ffestb_V0252_)  // to expression handler
+
+   Make sure the statement has a valid form for the DEFINEFILE statement.  If
+   it does, implement the statement.  */
+
+static ffelexHandler
+ffestb_V0252_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeOPEN_PAREN:
+      ffestb_local_.V025.u = expr;
+      ffesta_tokens[1] = ffelex_token_use (ft);
+      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+		   FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0253_);
+
+    default:
+      break;
+    }
+
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0253_ -- "DEFINEFILE" expr OPEN_PAREN expr
+
+   (ffestb_V0253_)  // to expression handler
+
+   Make sure the statement has a valid form for the DEFINEFILE statement.  If
+   it does, implement the statement.  */
+
+static ffelexHandler
+ffestb_V0253_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+      ffestb_local_.V025.m = expr;
+      ffesta_tokens[2] = ffelex_token_use (ft);
+      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+		   FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0254_);
+
+    default:
+      break;
+    }
+
+  ffelex_token_kill (ffesta_tokens[1]);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0254_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr
+
+   (ffestb_V0254_)  // to expression handler
+
+   Make sure the statement has a valid form for the DEFINEFILE statement.  If
+   it does, implement the statement.  */
+
+static ffelexHandler
+ffestb_V0254_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+      ffestb_local_.V025.n = expr;
+      ffesta_tokens[3] = ffelex_token_use (ft);
+      return (ffelexHandler) ffestb_V0255_;
+
+    default:
+      break;
+    }
+
+  ffelex_token_kill (ffesta_tokens[1]);
+  ffelex_token_kill (ffesta_tokens[2]);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0255_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA
+
+   return ffestb_V0255_;  // to lexer
+
+   Make sure the statement has a valid form for the DEFINEFILE statement.  If
+   it does, implement the statement.  */
+
+static ffelexHandler
+ffestb_V0255_ (ffelexToken t)
+{
+  char *p;
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      p = ffelex_token_text (t);
+      if (!ffesrc_char_match_init (*p, 'U', 'u') || (*++p != '\0'))
+	break;
+      return (ffelexHandler) ffestb_V0256_;
+
+    default:
+      break;
+    }
+
+  ffelex_token_kill (ffesta_tokens[1]);
+  ffelex_token_kill (ffesta_tokens[2]);
+  ffelex_token_kill (ffesta_tokens[3]);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0256_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA "U"
+
+   return ffestb_V0256_;  // to lexer
+
+   Make sure the statement has a valid form for the DEFINEFILE statement.  If
+   it does, implement the statement.  */
+
+static ffelexHandler
+ffestb_V0256_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+      return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+					  FFEEXPR_contextFILEASSOC,
+					  (ffeexprCallback) ffestb_V0257_);
+
+    default:
+      break;
+    }
+
+  ffelex_token_kill (ffesta_tokens[1]);
+  ffelex_token_kill (ffesta_tokens[2]);
+  ffelex_token_kill (ffesta_tokens[3]);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0257_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA "U"
+		    COMMA expr
+
+   (ffestb_V0257_)  // to expression handler
+
+   Make sure the statement has a valid form for the DEFINEFILE statement.  If
+   it does, implement the statement.  */
+
+static ffelexHandler
+ffestb_V0257_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCLOSE_PAREN:
+      ffestb_local_.V025.asv = expr;
+      ffesta_tokens[4] = ffelex_token_use (ft);
+      return (ffelexHandler) ffestb_V0258_;
+
+    default:
+      break;
+    }
+
+  ffelex_token_kill (ffesta_tokens[1]);
+  ffelex_token_kill (ffesta_tokens[2]);
+  ffelex_token_kill (ffesta_tokens[3]);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0258_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA "U"
+		    COMMA expr CLOSE_PAREN
+
+   return ffestb_V0258_;  // to lexer
+
+   Make sure the statement has a valid form for the DEFINEFILE statement.  If
+   it does, implement the statement.  */
+
+static ffelexHandler
+ffestb_V0258_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      if (!ffestb_local_.V025.started)
+	{
+	  ffesta_confirmed ();
+	  if (!ffesta_is_inhibited ())
+	    ffestc_V025_start ();
+	  ffestb_local_.V025.started = TRUE;
+	}
+      if (!ffesta_is_inhibited ())
+	ffestc_V025_item (ffestb_local_.V025.u, ffesta_tokens[1],
+			  ffestb_local_.V025.m, ffesta_tokens[2],
+			  ffestb_local_.V025.n, ffesta_tokens[3],
+			  ffestb_local_.V025.asv, ffesta_tokens[4]);
+      ffelex_token_kill (ffesta_tokens[1]);
+      ffelex_token_kill (ffesta_tokens[2]);
+      ffelex_token_kill (ffesta_tokens[3]);
+      ffelex_token_kill (ffesta_tokens[4]);
+      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+	return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+	       FFEEXPR_contextFILEUNIT_DF, (ffeexprCallback) ffestb_V0252_);
+      if (!ffesta_is_inhibited ())
+	ffestc_V025_finish ();
+      return (ffelexHandler) ffesta_zero (t);
+
+    default:
+      break;
+    }
+
+  ffelex_token_kill (ffesta_tokens[1]);
+  ffelex_token_kill (ffesta_tokens[2]);
+  ffelex_token_kill (ffesta_tokens[3]);
+  ffelex_token_kill (ffesta_tokens[4]);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_subr_kill_easy_ -- Kill I/O statement data structure
+
+   ffestb_subr_kill_easy_();
+
+   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_ ()
+{
+  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_ ()
+{
+  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_ ()
+{
+  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_ ()
+{
+  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_ ()
+{
+  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_ ()
+{
+  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_ ()
+{
+  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_ ()
+{
+  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_ ()
+{
+  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_ ()
+{
+  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_ ()
+{
+  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;
+
+#if FFESTR_VXT
+	    case FFESTR_firstUNLOCK:
+	      ffestc_V022 ();
+	      break;
+#endif
+
+	    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;
+
+#if FFESTR_VXT
+	    case FFESTR_firstUNLOCK:
+	      ffestc_V022 ();
+	      break;
+#endif
+
+	    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_vxtcode -- Parse the VXT DECODE/ENCODE statement
+
+   return ffestb_vxtcode;  // to lexer
+
+   Make sure the statement has a valid form for the VXT DECODE/ENCODE
+   statement.  If it does, implement the statement.  */
+
+#if FFESTR_VXT
+ffelexHandler
+ffestb_vxtcode (ffelexToken t)
+{
+  ffestpVxtcodeIx ix;
+
+  switch (ffelex_token_type (ffesta_tokens[0]))
+    {
+    case FFELEX_typeNAME:
+      switch (ffelex_token_type (t))
+	{
+	case FFELEX_typeCOMMA:
+	case FFELEX_typeCOLONCOLON:
+	case FFELEX_typeEOS:
+	case FFELEX_typeSEMICOLON:
+	case FFELEX_typeNAME:
+	case FFELEX_typeNUMBER:
+	  ffesta_confirmed ();	/* Error, but clearly intended. */
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	default:
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	case FFELEX_typeOPEN_PAREN:
+	  for (ix = 0; ix < FFESTP_vxtcodeix; ++ix)
+	    ffestp_file.vxtcode.vxtcode_spec[ix].kw_or_val_present = FALSE;
+	  return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+		FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_vxtcode1_);
+	}
+
+    case FFELEX_typeNAMES:
+      switch (ffelex_token_type (t))
+	{
+	case FFELEX_typeEOS:
+	case FFELEX_typeSEMICOLON:
+	case FFELEX_typeCOMMA:
+	case FFELEX_typeCOLONCOLON:
+	  ffesta_confirmed ();	/* Error, but clearly intended. */
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	default:
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	case FFELEX_typeOPEN_PAREN:
+	  if (ffelex_token_length (ffesta_tokens[0])
+	      != ffestb_args.vxtcode.len)
+	    goto bad_0;		/* :::::::::::::::::::: */
+
+	  for (ix = 0; ix < FFESTP_vxtcodeix; ++ix)
+	    ffestp_file.vxtcode.vxtcode_spec[ix].kw_or_val_present = FALSE;
+	  return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+		FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_vxtcode1_);
+	}
+
+    default:
+      goto bad_0;		/* :::::::::::::::::::: */
+    }
+
+bad_0:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, ffesta_tokens[0]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t,
+						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
+}
+
+/* ffestb_vxtcode1_ -- "VXTCODE" OPEN_PAREN expr
+
+   (ffestb_vxtcode1_)  // to expression handler
+
+   Handle COMMA here.  */
+
+static ffelexHandler
+ffestb_vxtcode1_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+      if (expr == NULL)
+	break;
+      ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].kw_or_val_present
+	= TRUE;
+      ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].kw_present = FALSE;
+      ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].value_present = TRUE;
+      ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].value_is_label
+	= FALSE;
+      ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].value
+	= ffelex_token_use (ft);
+      ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].u.expr = expr;
+      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+	     FFEEXPR_contextFILEFORMAT, (ffeexprCallback) ffestb_vxtcode2_);
+
+    default:
+      break;
+    }
+
+  ffestb_subr_kill_vxtcode_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode2_ -- "VXTCODE" OPEN_PAREN expr COMMA expr
+
+   (ffestb_vxtcode2_)  // to expression handler
+
+   Handle COMMA here.  */
+
+static ffelexHandler
+ffestb_vxtcode2_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+      ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].kw_or_val_present
+	= TRUE;
+      ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].kw_present = FALSE;
+      ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].value_present = TRUE;
+      ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].value_is_label
+	= (expr == NULL);
+      ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].value
+	= ffelex_token_use (ft);
+      ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].u.expr = expr;
+      if (ffesta_first_kw == FFESTR_firstENCODE)
+	return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+					    FFEEXPR_contextFILEVXTCODE,
+					(ffeexprCallback) ffestb_vxtcode3_);
+      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+					  FFEEXPR_contextFILEVXTCODE,
+					(ffeexprCallback) ffestb_vxtcode3_);
+
+    default:
+      break;
+    }
+
+  ffestb_subr_kill_vxtcode_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode3_ -- "VXTCODE" OPEN_PAREN expr COMMA expr COMMA expr
+
+   (ffestb_vxtcode3_)  // to expression handler
+
+   Handle COMMA or CLOSE_PAREN here.  */
+
+static ffelexHandler
+ffestb_vxtcode3_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeCLOSE_PAREN:
+      if (expr == NULL)
+	break;
+      ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].kw_or_val_present
+	= TRUE;
+      ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].kw_present = FALSE;
+      ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].value_present = TRUE;
+      ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].value_is_label
+	= FALSE;
+      ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].value
+	= ffelex_token_use (ft);
+      ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].u.expr = expr;
+      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+	return (ffelexHandler) ffestb_vxtcode4_;
+      return (ffelexHandler) ffestb_vxtcode9_;
+
+    default:
+      break;
+    }
+
+  ffestb_subr_kill_vxtcode_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode4_ -- "VXTCODE" OPEN_PAREN ...
+
+   return ffestb_vxtcode4_;  // to lexer
+
+   Handle NAME=expr construct here.  */
+
+static ffelexHandler
+ffestb_vxtcode4_ (ffelexToken t)
+{
+  ffestrGenio kw;
+
+  ffestb_local_.vxtcode.label = FALSE;
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      kw = ffestr_genio (t);
+      switch (kw)
+	{
+	case FFESTR_genioERR:
+	  ffestb_local_.vxtcode.ix = FFESTP_vxtcodeixERR;
+	  ffestb_local_.vxtcode.label = TRUE;
+	  break;
+
+	case FFESTR_genioIOSTAT:
+	  ffestb_local_.vxtcode.ix = FFESTP_vxtcodeixIOSTAT;
+	  ffestb_local_.vxtcode.left = TRUE;
+	  ffestb_local_.vxtcode.context = FFEEXPR_contextFILEINT;
+	  break;
+
+	default:
+	  goto bad;		/* :::::::::::::::::::: */
+	}
+      if (ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix]
+	  .kw_or_val_present)
+	break;			/* Can't specify a keyword twice! */
+      ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix]
+	.kw_or_val_present = TRUE;
+      ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix]
+	.kw_present = TRUE;
+      ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix]
+	.value_present = FALSE;
+      ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value_is_label
+	= ffestb_local_.vxtcode.label;
+      ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].kw
+	= ffelex_token_use (t);
+      return (ffelexHandler) ffestb_vxtcode5_;
+
+    default:
+      break;
+    }
+
+bad:				/* :::::::::::::::::::: */
+  ffestb_subr_kill_vxtcode_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode5_ -- "VXTCODE" OPEN_PAREN [external-file-unit COMMA [format
+		   COMMA]] NAME
+
+   return ffestb_vxtcode5_;  // to lexer
+
+   Make sure EQUALS here, send next token to expression handler.  */
+
+static ffelexHandler
+ffestb_vxtcode5_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEQUALS:
+      ffesta_confirmed ();
+      if (ffestb_local_.vxtcode.label)
+	return (ffelexHandler) ffestb_vxtcode7_;
+      if (ffestb_local_.vxtcode.left)
+	return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+					    ffestb_local_.vxtcode.context,
+					(ffeexprCallback) ffestb_vxtcode6_);
+      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+					  ffestb_local_.vxtcode.context,
+					(ffeexprCallback) ffestb_vxtcode6_);
+
+    default:
+      break;
+    }
+
+  ffestb_subr_kill_vxtcode_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode6_ -- "VXTCODE" OPEN_PAREN ... NAME EQUALS expr
+
+   (ffestb_vxtcode6_)  // to expression handler
+
+   Handle COMMA or CLOSE_PAREN here.  */
+
+static ffelexHandler
+ffestb_vxtcode6_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeCLOSE_PAREN:
+      if (expr == NULL)
+	break;
+      ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value_present
+	= TRUE;
+      ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value
+	= ffelex_token_use (ft);
+      ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].u.expr = expr;
+      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+	return (ffelexHandler) ffestb_vxtcode4_;
+      return (ffelexHandler) ffestb_vxtcode9_;
+
+    default:
+      break;
+    }
+
+  ffestb_subr_kill_vxtcode_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode7_ -- "VXTCODE" OPEN_PAREN ... NAME EQUALS
+
+   return ffestb_vxtcode7_;  // to lexer
+
+   Handle NUMBER for label here.  */
+
+static ffelexHandler
+ffestb_vxtcode7_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNUMBER:
+      ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value_present
+	= TRUE;
+      ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value
+	= ffelex_token_use (t);
+      return (ffelexHandler) ffestb_vxtcode8_;
+
+    default:
+      break;
+    }
+
+  ffestb_subr_kill_vxtcode_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode8_ -- "VXTCODE" OPEN_PAREN ... NAME EQUALS NUMBER
+
+   return ffestb_vxtcode8_;  // to lexer
+
+   Handle COMMA or CLOSE_PAREN here.  */
+
+static ffelexHandler
+ffestb_vxtcode8_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+      return (ffelexHandler) ffestb_vxtcode4_;
+
+    case FFELEX_typeCLOSE_PAREN:
+      return (ffelexHandler) ffestb_vxtcode9_;
+
+    default:
+      break;
+    }
+
+  ffestb_subr_kill_vxtcode_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode9_ -- "VXTCODE" OPEN_PAREN ... CLOSE_PAREN
+
+   return ffestb_vxtcode9_;  // to lexer
+
+   Handle EOS or SEMICOLON here.
+
+   07-Jun-90  JCB  1.1
+      Context for ENCODE/DECODE expressions is now IOLISTDF instead of IOLIST
+      since they apply to internal files.  */
+
+static ffelexHandler
+ffestb_vxtcode9_ (ffelexToken t)
+{
+  ffelexHandler next;
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      ffesta_confirmed ();
+      if (!ffesta_is_inhibited ())
+	{
+	  if (ffesta_first_kw == FFESTR_firstENCODE)
+	    {
+	      ffestc_V023_start ();
+	      ffestc_V023_finish ();
+	    }
+	  else
+	    {
+	      ffestc_V024_start ();
+	      ffestc_V024_finish ();
+	    }
+	}
+      ffestb_subr_kill_vxtcode_ ();
+      return (ffelexHandler) ffesta_zero (t);
+
+    case FFELEX_typeNAME:
+    case FFELEX_typeOPEN_PAREN:
+    case FFELEX_typeCOMMA:
+      ffesta_confirmed ();
+      if (!ffesta_is_inhibited ())
+	if (ffesta_first_kw == FFESTR_firstENCODE)
+	  ffestc_V023_start ();
+	else
+	  ffestc_V024_start ();
+      ffestb_subr_kill_vxtcode_ ();
+      if (ffesta_first_kw == FFESTR_firstDECODE)
+	next = (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+					    FFEEXPR_contextIOLISTDF,
+				       (ffeexprCallback) ffestb_vxtcode10_);
+      else
+	next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+					    FFEEXPR_contextIOLISTDF,
+				       (ffeexprCallback) ffestb_vxtcode10_);
+
+      /* EXTENSION: Allow an optional preceding COMMA here if not pedantic.
+	 (f2c provides this extension, as do other compilers, supposedly.) */
+
+      if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA))
+	return next;
+
+      return (ffelexHandler) (*next) (t);
+
+    default:
+      break;
+    }
+
+  ffestb_subr_kill_vxtcode_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode10_ -- "VXTCODE(...)" expr
+
+   (ffestb_vxtcode10_)	// to expression handler
+
+   Handle COMMA or EOS/SEMICOLON here.
+
+   07-Jun-90  JCB  1.1
+      Context for ENCODE/DECODE expressions is now IOLISTDF instead of IOLIST
+      since they apply to internal files.  */
+
+static ffelexHandler
+ffestb_vxtcode10_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+      if (expr == NULL)
+	break;
+      if (!ffesta_is_inhibited ())
+	if (ffesta_first_kw == FFESTR_firstENCODE)
+	  ffestc_V023_item (expr, ft);
+	else
+	  ffestc_V024_item (expr, ft);
+      if (ffesta_first_kw == FFESTR_firstDECODE)
+	return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+					    FFEEXPR_contextIOLISTDF,
+				       (ffeexprCallback) ffestb_vxtcode10_);
+      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+					  FFEEXPR_contextIOLISTDF,
+				       (ffeexprCallback) ffestb_vxtcode10_);
+
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      if (expr == NULL)
+	break;
+      if (!ffesta_is_inhibited ())
+	{
+	  if (ffesta_first_kw == FFESTR_firstENCODE)
+	    {
+	      ffestc_V023_item (expr, ft);
+	      ffestc_V023_finish ();
+	    }
+	  else
+	    {
+	      ffestc_V024_item (expr, ft);
+	      ffestc_V024_finish ();
+	    }
+	}
+      return (ffelexHandler) ffesta_zero (t);
+
+    default:
+      break;
+    }
+
+  if (!ffesta_is_inhibited ())
+    if (ffesta_first_kw == FFESTR_firstENCODE)
+      ffestc_V023_finish ();
+    else
+      ffestc_V024_finish ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_R904 -- Parse an OPEN statement
+
+   return ffestb_R904;	// to lexer
+
+   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_V018 -- Parse the REWRITE statement
+
+   return ffestb_V018;	// to lexer
+
+   Make sure the statement has a valid form for the REWRITE
+   statement.  If it does, implement the statement.  */
+
+#if FFESTR_VXT
+ffelexHandler
+ffestb_V018 (ffelexToken t)
+{
+  ffestpRewriteIx ix;
+
+  switch (ffelex_token_type (ffesta_tokens[0]))
+    {
+    case FFELEX_typeNAME:
+      if (ffesta_first_kw != FFESTR_firstREWRITE)
+	goto bad_0;		/* :::::::::::::::::::: */
+      switch (ffelex_token_type (t))
+	{
+	case FFELEX_typeCOMMA:
+	case FFELEX_typeCOLONCOLON:
+	case FFELEX_typeEOS:
+	case FFELEX_typeSEMICOLON:
+	case FFELEX_typeNAME:
+	case FFELEX_typeNUMBER:
+	  ffesta_confirmed ();	/* Error, but clearly intended. */
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	default:
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	case FFELEX_typeOPEN_PAREN:
+	  for (ix = 0; ix < FFESTP_rewriteix; ++ix)
+	    ffestp_file.rewrite.rewrite_spec[ix].kw_or_val_present = FALSE;
+	  return (ffelexHandler) ffestb_V0181_;
+	}
+
+    case FFELEX_typeNAMES:
+      if (ffesta_first_kw != FFESTR_firstREWRITE)
+	goto bad_0;		/* :::::::::::::::::::: */
+      switch (ffelex_token_type (t))
+	{
+	case FFELEX_typeEOS:
+	case FFELEX_typeSEMICOLON:
+	case FFELEX_typeCOMMA:
+	case FFELEX_typeCOLONCOLON:
+	  ffesta_confirmed ();	/* Error, but clearly intended. */
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	default:
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	case FFELEX_typeOPEN_PAREN:
+	  if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlREWRITE)
+	    goto bad_0;		/* :::::::::::::::::::: */
+
+	  for (ix = 0; ix < FFESTP_rewriteix; ++ix)
+	    ffestp_file.rewrite.rewrite_spec[ix].kw_or_val_present = FALSE;
+	  return (ffelexHandler) ffestb_V0181_;
+	}
+
+    default:
+      goto bad_0;		/* :::::::::::::::::::: */
+    }
+
+bad_0:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", ffesta_tokens[0]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t,
+						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
+}
+
+/* ffestb_V0181_ -- "REWRITE" OPEN_PAREN
+
+   return ffestb_V0181_;  // to lexer
+
+   Handle expr construct (not NAME=expr construct) here.  */
+
+static ffelexHandler
+ffestb_V0181_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      ffesta_tokens[1] = ffelex_token_use (t);
+      return (ffelexHandler) ffestb_V0182_;
+
+    default:
+      return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+		  FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0183_)))
+	(t);
+    }
+}
+
+/* ffestb_V0182_ -- "REWRITE" OPEN_PAREN NAME
+
+   return ffestb_V0182_;  // to lexer
+
+   If EQUALS here, go to states that handle it.	 Else, send NAME and this
+   token thru expression handler.  */
+
+static ffelexHandler
+ffestb_V0182_ (ffelexToken t)
+{
+  ffelexHandler next;
+  ffelexToken nt;
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEQUALS:
+      nt = ffesta_tokens[1];
+      next = (ffelexHandler) ffestb_V0187_ (nt);
+      ffelex_token_kill (nt);
+      return (ffelexHandler) (*next) (t);
+
+    default:
+      nt = ffesta_tokens[1];
+      next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+		  FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0183_)))
+	(nt);
+      ffelex_token_kill (nt);
+      return (ffelexHandler) (*next) (t);
+    }
+}
+
+/* ffestb_V0183_ -- "REWRITE" OPEN_PAREN expr [CLOSE_PAREN]
+
+   (ffestb_V0183_)  // to expression handler
+
+   Handle COMMA or EOS/SEMICOLON here.	*/
+
+static ffelexHandler
+ffestb_V0183_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeCLOSE_PAREN:
+      if (expr == NULL)
+	break;
+      ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].kw_or_val_present
+	= TRUE;
+      ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].kw_present = FALSE;
+      ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].value_present = TRUE;
+      ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].value_is_label
+	= FALSE;
+      ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].value
+	= ffelex_token_use (ft);
+      ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].u.expr = expr;
+      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+	return (ffelexHandler) ffestb_V0184_;
+      return (ffelexHandler) ffestb_V01812_;
+
+    default:
+      break;
+    }
+
+  ffestb_subr_kill_rewrite_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0184_ -- "REWRITE" OPEN_PAREN expr COMMA
+
+   return ffestb_V0184_;  // to lexer
+
+   Handle expr construct (not NAME=expr construct) here.  */
+
+static ffelexHandler
+ffestb_V0184_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      ffesta_tokens[1] = ffelex_token_use (t);
+      return (ffelexHandler) ffestb_V0185_;
+
+    default:
+      return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+	       FFEEXPR_contextFILEFORMAT, (ffeexprCallback) ffestb_V0186_)))
+	(t);
+    }
+}
+
+/* ffestb_V0185_ -- "REWRITE" OPEN_PAREN expr COMMA NAME
+
+   return ffestb_V0185_;  // to lexer
+
+   If EQUALS here, go to states that handle it.	 Else, send NAME and this
+   token thru expression handler.  */
+
+static ffelexHandler
+ffestb_V0185_ (ffelexToken t)
+{
+  ffelexHandler next;
+  ffelexToken nt;
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEQUALS:
+      nt = ffesta_tokens[1];
+      next = (ffelexHandler) ffestb_V0187_ (nt);
+      ffelex_token_kill (nt);
+      return (ffelexHandler) (*next) (t);
+
+    default:
+      nt = ffesta_tokens[1];
+      next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+	       FFEEXPR_contextFILEFORMAT, (ffeexprCallback) ffestb_V0186_)))
+	(nt);
+      ffelex_token_kill (nt);
+      return (ffelexHandler) (*next) (t);
+    }
+}
+
+/* ffestb_V0186_ -- "REWRITE" OPEN_PAREN expr COMMA expr
+
+   (ffestb_V0186_)  // to expression handler
+
+   Handle COMMA or CLOSE_PAREN here.  */
+
+static ffelexHandler
+ffestb_V0186_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeCLOSE_PAREN:
+      ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw_or_val_present
+	= TRUE;
+      ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw_present = FALSE;
+      ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value_present = TRUE;
+      ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value_is_label
+	= (expr == NULL);
+      ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value
+	= ffelex_token_use (ft);
+      ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].u.expr = expr;
+      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+	return (ffelexHandler) ffestb_V0187_;
+      return (ffelexHandler) ffestb_V01812_;
+
+    default:
+      break;
+    }
+
+  ffestb_subr_kill_rewrite_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0187_ -- "REWRITE" OPEN_PAREN [external-file-unit COMMA [format
+		   COMMA]]
+
+   return ffestb_V0187_;  // to lexer
+
+   Handle expr construct (not NAME=expr construct) here.  */
+
+static ffelexHandler
+ffestb_V0187_ (ffelexToken t)
+{
+  ffestrGenio kw;
+
+  ffestb_local_.rewrite.label = FALSE;
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      kw = ffestr_genio (t);
+      switch (kw)
+	{
+	case FFESTR_genioERR:
+	  ffestb_local_.rewrite.ix = FFESTP_rewriteixERR;
+	  ffestb_local_.rewrite.label = TRUE;
+	  break;
+
+	case FFESTR_genioFMT:
+	  ffestb_local_.rewrite.ix = FFESTP_rewriteixFMT;
+	  ffestb_local_.rewrite.left = FALSE;
+	  ffestb_local_.rewrite.context = FFEEXPR_contextFILEFORMAT;
+	  break;
+
+	case FFESTR_genioIOSTAT:
+	  ffestb_local_.rewrite.ix = FFESTP_rewriteixIOSTAT;
+	  ffestb_local_.rewrite.left = TRUE;
+	  ffestb_local_.rewrite.context = FFEEXPR_contextFILEINT;
+	  break;
+
+	case FFESTR_genioUNIT:
+	  ffestb_local_.rewrite.ix = FFESTP_rewriteixUNIT;
+	  ffestb_local_.rewrite.left = FALSE;
+	  ffestb_local_.rewrite.context = FFEEXPR_contextFILENUM;
+	  break;
+
+	default:
+	  goto bad;		/* :::::::::::::::::::: */
+	}
+      if (ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
+	  .kw_or_val_present)
+	break;			/* Can't specify a keyword twice! */
+      ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
+	.kw_or_val_present = TRUE;
+      ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
+	.kw_present = TRUE;
+      ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
+	.value_present = FALSE;
+      ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value_is_label
+	= ffestb_local_.rewrite.label;
+      ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].kw
+	= ffelex_token_use (t);
+      return (ffelexHandler) ffestb_V0188_;
+
+    default:
+      break;
+    }
+
+bad:				/* :::::::::::::::::::: */
+  ffestb_subr_kill_rewrite_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0188_ -- "REWRITE" OPEN_PAREN [external-file-unit COMMA [format
+		   COMMA]] NAME
+
+   return ffestb_V0188_;  // to lexer
+
+   Make sure EQUALS here, send next token to expression handler.  */
+
+static ffelexHandler
+ffestb_V0188_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEQUALS:
+      ffesta_confirmed ();
+      if (ffestb_local_.rewrite.label)
+	return (ffelexHandler) ffestb_V01810_;
+      if (ffestb_local_.rewrite.left)
+	return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+					    ffestb_local_.rewrite.context,
+					    (ffeexprCallback) ffestb_V0189_);
+      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+					  ffestb_local_.rewrite.context,
+					  (ffeexprCallback) ffestb_V0189_);
+
+    default:
+      break;
+    }
+
+  ffestb_subr_kill_rewrite_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0189_ -- "REWRITE" OPEN_PAREN ... NAME EQUALS expr
+
+   (ffestb_V0189_)  // to expression handler
+
+   Handle COMMA or CLOSE_PAREN here.  */
+
+static ffelexHandler
+ffestb_V0189_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeCLOSE_PAREN:
+      if (expr == NULL)
+	if (ffestb_local_.rewrite.context == FFEEXPR_contextFILEFORMAT)
+	  ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
+	    .value_is_label = TRUE;
+	else
+	  break;
+      ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value_present
+	= TRUE;
+      ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value
+	= ffelex_token_use (ft);
+      ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].u.expr = expr;
+      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+	return (ffelexHandler) ffestb_V0187_;
+      return (ffelexHandler) ffestb_V01812_;
+
+    default:
+      break;
+    }
+
+  ffestb_subr_kill_rewrite_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V01810_ -- "REWRITE" OPEN_PAREN ... NAME EQUALS
+
+   return ffestb_V01810_;  // to lexer
+
+   Handle NUMBER for label here.  */
+
+static ffelexHandler
+ffestb_V01810_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNUMBER:
+      ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value_present
+	= TRUE;
+      ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value
+	= ffelex_token_use (t);
+      return (ffelexHandler) ffestb_V01811_;
+
+    default:
+      break;
+    }
+
+  ffestb_subr_kill_rewrite_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V01811_ -- "REWRITE" OPEN_PAREN ... NAME EQUALS NUMBER
+
+   return ffestb_V01811_;  // to lexer
+
+   Handle COMMA or CLOSE_PAREN here.  */
+
+static ffelexHandler
+ffestb_V01811_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+      return (ffelexHandler) ffestb_V0187_;
+
+    case FFELEX_typeCLOSE_PAREN:
+      return (ffelexHandler) ffestb_V01812_;
+
+    default:
+      break;
+    }
+
+  ffestb_subr_kill_rewrite_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V01812_ -- "REWRITE" OPEN_PAREN ... CLOSE_PAREN
+
+   return ffestb_V01812_;  // to lexer
+
+   Handle EOS or SEMICOLON here.  */
+
+static ffelexHandler
+ffestb_V01812_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      ffesta_confirmed ();
+      if (!ffesta_is_inhibited ())
+	{
+	  ffestc_V018_start ();
+	  ffestc_V018_finish ();
+	}
+      ffestb_subr_kill_rewrite_ ();
+      return (ffelexHandler) ffesta_zero (t);
+
+    case FFELEX_typeNAME:
+    case FFELEX_typeOPEN_PAREN:
+    case FFELEX_typeCOMMA:
+      ffesta_confirmed ();
+      if (!ffesta_is_inhibited ())
+	ffestc_V018_start ();
+      ffestb_subr_kill_rewrite_ ();
+
+      /* EXTENSION: Allow an optional preceding COMMA here if not pedantic.
+	 (f2c provides this extension, as do other compilers, supposedly.) */
+
+      if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA))
+	return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+		   FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V01813_);
+
+      return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+		  FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V01813_)))
+	(t);
+
+    default:
+      break;
+    }
+
+  ffestb_subr_kill_rewrite_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V01813_ -- "REWRITE(...)" expr
+
+   (ffestb_V01813_)  // to expression handler
+
+   Handle COMMA or EOS/SEMICOLON here.	*/
+
+static ffelexHandler
+ffestb_V01813_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+      if (expr == NULL)
+	break;
+      if (!ffesta_is_inhibited ())
+	ffestc_V018_item (expr, ft);
+      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+		   FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V01813_);
+
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      if (expr == NULL)
+	break;
+      if (!ffesta_is_inhibited ())
+	{
+	  ffestc_V018_item (expr, ft);
+	  ffestc_V018_finish ();
+	}
+      return (ffelexHandler) ffesta_zero (t);
+
+    default:
+      break;
+    }
+
+  if (!ffesta_is_inhibited ())
+    ffestc_V018_finish ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V019 -- Parse the ACCEPT statement
+
+   return ffestb_V019;	// to lexer
+
+   Make sure the statement has a valid form for the ACCEPT
+   statement.  If it does, implement the statement.  */
+
+ffelexHandler
+ffestb_V019 (ffelexToken t)
+{
+  ffelexHandler next;
+  ffestpAcceptIx ix;
+
+  switch (ffelex_token_type (ffesta_tokens[0]))
+    {
+    case FFELEX_typeNAME:
+      if (ffesta_first_kw != FFESTR_firstACCEPT)
+	goto bad_0;		/* :::::::::::::::::::: */
+      switch (ffelex_token_type (t))
+	{
+	case FFELEX_typeCOMMA:
+	case FFELEX_typeCOLONCOLON:
+	case FFELEX_typeEOS:
+	case FFELEX_typeSEMICOLON:
+	  ffesta_confirmed ();	/* Error, but clearly intended. */
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	case FFELEX_typeEQUALS:
+	case FFELEX_typePOINTS:
+	case FFELEX_typeCOLON:
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	case FFELEX_typeNAME:
+	case FFELEX_typeNUMBER:
+	  ffesta_confirmed ();
+	  break;
+
+	default:
+	  break;
+	}
+
+      for (ix = 0; ix < FFESTP_acceptix; ++ix)
+	ffestp_file.accept.accept_spec[ix].kw_or_val_present = FALSE;
+      return (ffelexHandler) (*((ffelexHandler)
+				ffeexpr_rhs (ffesta_output_pool,
+	    FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0191_)))
+	(t);
+
+    case FFELEX_typeNAMES:
+      if (ffesta_first_kw != FFESTR_firstACCEPT)
+	goto bad_0;		/* :::::::::::::::::::: */
+      switch (ffelex_token_type (t))
+	{
+	case FFELEX_typeEOS:
+	case FFELEX_typeSEMICOLON:
+	case FFELEX_typeCOMMA:
+	  ffesta_confirmed ();
+	  if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlACCEPT)
+	    break;
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	case FFELEX_typeCOLONCOLON:
+	  ffesta_confirmed ();	/* Error, but clearly intended. */
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	case FFELEX_typeEQUALS:
+	case FFELEX_typePOINTS:
+	case FFELEX_typeCOLON:
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	default:
+	  break;
+	}
+      for (ix = 0; ix < FFESTP_acceptix; ++ix)
+	ffestp_file.accept.accept_spec[ix].kw_or_val_present = FALSE;
+      next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+	     FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0191_);
+      next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
+						   FFESTR_firstlACCEPT);
+      if (next == NULL)
+	return (ffelexHandler) ffelex_swallow_tokens (t,
+					       (ffelexHandler) ffesta_zero);
+      return (ffelexHandler) (*next) (t);
+
+    default:
+      goto bad_0;		/* :::::::::::::::::::: */
+    }
+
+bad_0:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", ffesta_tokens[0]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t,
+						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
+}
+
+/* ffestb_V0191_ -- "ACCEPT" expr
+
+   (ffestb_V0191_)  // to expression handler
+
+   Make sure the next token is a COMMA or EOS/SEMICOLON.  */
+
+static ffelexHandler
+ffestb_V0191_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+    case FFELEX_typeCOMMA:
+      ffesta_confirmed ();
+      ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].kw_or_val_present
+	= TRUE;
+      ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].kw_present = FALSE;
+      ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].value_present = TRUE;
+      ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].value_is_label
+	= (expr == NULL);
+      ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].value
+	= ffelex_token_use (ft);
+      ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].u.expr = expr;
+      if (!ffesta_is_inhibited ())
+	ffestc_V019_start ();
+      ffestb_subr_kill_accept_ ();
+      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+	return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+					    FFEEXPR_contextIOLIST,
+					    (ffeexprCallback) ffestb_V0192_);
+      if (!ffesta_is_inhibited ())
+	ffestc_V019_finish ();
+      return (ffelexHandler) ffesta_zero (t);
+
+    default:
+      break;
+    }
+
+  ffestb_subr_kill_accept_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0192_ -- "ACCEPT" expr COMMA expr
+
+   (ffestb_V0192_)  // to expression handler
+
+   Handle COMMA or EOS/SEMICOLON here.	*/
+
+static ffelexHandler
+ffestb_V0192_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+      if (expr == NULL)
+	break;
+      if (!ffesta_is_inhibited ())
+	ffestc_V019_item (expr, ft);
+      return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+					  FFEEXPR_contextIOLIST,
+					  (ffeexprCallback) ffestb_V0192_);
+
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      if (expr == NULL)
+	break;
+      if (!ffesta_is_inhibited ())
+	{
+	  ffestc_V019_item (expr, ft);
+	  ffestc_V019_finish ();
+	}
+      return (ffelexHandler) ffesta_zero (t);
+
+    default:
+      break;
+    }
+
+  if (!ffesta_is_inhibited ())
+    ffestc_V019_finish ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_V020 -- Parse the TYPE statement
+
+   return ffestb_V020;	// to lexer
+
+   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;
+  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_V021 -- Parse a DELETE statement
+
+   return ffestb_V021;	// to lexer
+
+   Make sure the statement has a valid form for a DELETE statement.
+   If it does, implement the statement.	 */
+
+#if FFESTR_VXT
+ffelexHandler
+ffestb_V021 (ffelexToken t)
+{
+  ffestpDeleteIx ix;
+
+  switch (ffelex_token_type (ffesta_tokens[0]))
+    {
+    case FFELEX_typeNAME:
+      if (ffesta_first_kw != FFESTR_firstDELETE)
+	goto bad_0;		/* :::::::::::::::::::: */
+      break;
+
+    case FFELEX_typeNAMES:
+      if (ffesta_first_kw != FFESTR_firstDELETE)
+	goto bad_0;		/* :::::::::::::::::::: */
+      if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlDELETE)
+	goto bad_0;		/* :::::::::::::::::::: */
+      break;
+
+    default:
+      goto bad_0;		/* :::::::::::::::::::: */
+    }
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeOPEN_PAREN:
+      break;
+
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeCOLONCOLON:
+      ffesta_confirmed ();	/* Error, but clearly intended. */
+      goto bad_1;		/* :::::::::::::::::::: */
+
+    default:
+      goto bad_1;		/* :::::::::::::::::::: */
+    }
+
+  for (ix = 0; ix < FFESTP_deleteix; ++ix)
+    ffestp_file.delete.delete_spec[ix].kw_or_val_present = FALSE;
+
+  return (ffelexHandler) ffestb_V0211_;
+
+bad_0:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", ffesta_tokens[0]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t,
+						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
+}
+
+/* ffestb_V0211_ -- "DELETE" OPEN_PAREN
+
+   return ffestb_V0211_;  // to lexer
+
+   Handle expr construct (not NAME=expr construct) here.  */
+
+static ffelexHandler
+ffestb_V0211_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      ffesta_tokens[1] = ffelex_token_use (t);
+      return (ffelexHandler) ffestb_V0212_;
+
+    default:
+      return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+		  FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0213_)))
+	(t);
+    }
+}
+
+/* ffestb_V0212_ -- "DELETE" OPEN_PAREN NAME
+
+   return ffestb_V0212_;  // to lexer
+
+   If EQUALS here, go to states that handle it.	 Else, send NAME and this
+   token thru expression handler.  */
+
+static ffelexHandler
+ffestb_V0212_ (ffelexToken t)
+{
+  ffelexHandler next;
+  ffelexToken nt;
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEQUALS:
+      nt = ffesta_tokens[1];
+      next = (ffelexHandler) ffestb_V0214_ (nt);
+      ffelex_token_kill (nt);
+      return (ffelexHandler) (*next) (t);
+
+    default:
+      next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+		  FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0213_)))
+	(ffesta_tokens[1]);
+      ffelex_token_kill (ffesta_tokens[1]);
+      return (ffelexHandler) (*next) (t);
+    }
+}
+
+/* ffestb_V0213_ -- "DELETE" OPEN_PAREN expr
+
+   (ffestb_V0213_)  // to expression handler
+
+   Handle COMMA or DELETE_PAREN here.  */
+
+static ffelexHandler
+ffestb_V0213_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeCLOSE_PAREN:
+      if (expr == NULL)
+	break;
+      ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].kw_or_val_present
+	= TRUE;
+      ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].kw_present = FALSE;
+      ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].value_present = TRUE;
+      ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].value_is_label
+	= FALSE;
+      ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].value
+	= ffelex_token_use (ft);
+      ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].u.expr = expr;
+      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+	return (ffelexHandler) ffestb_V0214_;
+      return (ffelexHandler) ffestb_V0219_;
+
+    default:
+      break;
+    }
+
+  ffestb_subr_kill_delete_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0214_ -- "DELETE" OPEN_PAREN [external-file-unit COMMA]
+
+   return ffestb_V0214_;  // to lexer
+
+   Handle expr construct (not NAME=expr construct) here.  */
+
+static ffelexHandler
+ffestb_V0214_ (ffelexToken t)
+{
+  ffestrGenio kw;
+
+  ffestb_local_.delete.label = FALSE;
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      kw = ffestr_genio (t);
+      switch (kw)
+	{
+	case FFESTR_genioERR:
+	  ffestb_local_.delete.ix = FFESTP_deleteixERR;
+	  ffestb_local_.delete.label = TRUE;
+	  break;
+
+	case FFESTR_genioIOSTAT:
+	  ffestb_local_.delete.ix = FFESTP_deleteixIOSTAT;
+	  ffestb_local_.delete.left = TRUE;
+	  ffestb_local_.delete.context = FFEEXPR_contextFILEINT;
+	  break;
+
+	case FFESTR_genioREC:
+	  ffestb_local_.delete.ix = FFESTP_deleteixREC;
+	  ffestb_local_.delete.left = FALSE;
+	  ffestb_local_.delete.context = FFEEXPR_contextFILENUM;
+	  break;
+
+	case FFESTR_genioUNIT:
+	  ffestb_local_.delete.ix = FFESTP_deleteixUNIT;
+	  ffestb_local_.delete.left = FALSE;
+	  ffestb_local_.delete.context = FFEEXPR_contextFILENUM;
+	  break;
+
+	default:
+	  goto bad;		/* :::::::::::::::::::: */
+	}
+      if (ffestp_file.delete.delete_spec[ffestb_local_.delete.ix]
+	  .kw_or_val_present)
+	break;			/* Can't specify a keyword twice! */
+      ffestp_file.delete.delete_spec[ffestb_local_.delete.ix]
+	.kw_or_val_present = TRUE;
+      ffestp_file.delete.delete_spec[ffestb_local_.delete.ix]
+	.kw_present = TRUE;
+      ffestp_file.delete.delete_spec[ffestb_local_.delete.ix]
+	.value_present = FALSE;
+      ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value_is_label
+	= ffestb_local_.delete.label;
+      ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].kw
+	= ffelex_token_use (t);
+      return (ffelexHandler) ffestb_V0215_;
+
+    default:
+      break;
+    }
+
+bad:				/* :::::::::::::::::::: */
+  ffestb_subr_kill_delete_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0215_ -- "DELETE" OPEN_PAREN [external-file-unit COMMA] NAME
+
+   return ffestb_V0215_;  // to lexer
+
+   Make sure EQUALS here, send next token to expression handler.  */
+
+static ffelexHandler
+ffestb_V0215_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEQUALS:
+      ffesta_confirmed ();
+      if (ffestb_local_.delete.label)
+	return (ffelexHandler) ffestb_V0217_;
+      if (ffestb_local_.delete.left)
+	return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+					    ffestb_local_.delete.context,
+					    (ffeexprCallback) ffestb_V0216_);
+      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+	     ffestb_local_.delete.context, (ffeexprCallback) ffestb_V0216_);
+
+    default:
+      break;
+    }
+
+  ffestb_subr_kill_delete_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0216_ -- "DELETE" OPEN_PAREN ... NAME EQUALS expr
+
+   (ffestb_V0216_)  // to expression handler
+
+   Handle COMMA or CLOSE_PAREN here.  */
+
+static ffelexHandler
+ffestb_V0216_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeCLOSE_PAREN:
+      if (expr == NULL)
+	break;
+      ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value_present
+	= TRUE;
+      ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value
+	= ffelex_token_use (ft);
+      ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].u.expr = expr;
+      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+	return (ffelexHandler) ffestb_V0214_;
+      return (ffelexHandler) ffestb_V0219_;
+
+    default:
+      break;
+    }
+
+  ffestb_subr_kill_delete_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0217_ -- "DELETE" OPEN_PAREN ... NAME EQUALS
+
+   return ffestb_V0217_;  // to lexer
+
+   Handle NUMBER for label here.  */
+
+static ffelexHandler
+ffestb_V0217_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNUMBER:
+      ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value_present
+	= TRUE;
+      ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value
+	= ffelex_token_use (t);
+      return (ffelexHandler) ffestb_V0218_;
+
+    default:
+      break;
+    }
+
+  ffestb_subr_kill_delete_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0218_ -- "DELETE" OPEN_PAREN ... NAME EQUALS NUMBER
+
+   return ffestb_V0218_;  // to lexer
+
+   Handle COMMA or CLOSE_PAREN here.  */
+
+static ffelexHandler
+ffestb_V0218_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+      return (ffelexHandler) ffestb_V0214_;
+
+    case FFELEX_typeCLOSE_PAREN:
+      return (ffelexHandler) ffestb_V0219_;
+
+    default:
+      break;
+    }
+
+  ffestb_subr_kill_delete_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0219_ -- "DELETE" OPEN_PAREN ... CLOSE_PAREN
+
+   return ffestb_V0219_;  // to lexer
+
+   Handle EOS or SEMICOLON here.  */
+
+static ffelexHandler
+ffestb_V0219_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      ffesta_confirmed ();
+      if (!ffesta_is_inhibited ())
+	ffestc_V021 ();
+      ffestb_subr_kill_delete_ ();
+      return (ffelexHandler) ffesta_zero (t);
+
+    default:
+      break;
+    }
+
+  ffestb_subr_kill_delete_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V026 -- Parse a FIND statement
+
+   return ffestb_V026;	// to lexer
+
+   Make sure the statement has a valid form for a FIND statement.
+   If it does, implement the statement.	 */
+
+ffelexHandler
+ffestb_V026 (ffelexToken t)
+{
+  ffestpFindIx ix;
+
+  switch (ffelex_token_type (ffesta_tokens[0]))
+    {
+    case FFELEX_typeNAME:
+      if (ffesta_first_kw != FFESTR_firstFIND)
+	goto bad_0;		/* :::::::::::::::::::: */
+      break;
+
+    case FFELEX_typeNAMES:
+      if (ffesta_first_kw != FFESTR_firstFIND)
+	goto bad_0;		/* :::::::::::::::::::: */
+      if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlFIND)
+	goto bad_0;		/* :::::::::::::::::::: */
+      break;
+
+    default:
+      goto bad_0;		/* :::::::::::::::::::: */
+    }
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeOPEN_PAREN:
+      break;
+
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeCOLONCOLON:
+      ffesta_confirmed ();	/* Error, but clearly intended. */
+      goto bad_1;		/* :::::::::::::::::::: */
+
+    default:
+      goto bad_1;		/* :::::::::::::::::::: */
+    }
+
+  for (ix = 0; ix < FFESTP_findix; ++ix)
+    ffestp_file.find.find_spec[ix].kw_or_val_present = FALSE;
+
+  return (ffelexHandler) ffestb_V0261_;
+
+bad_0:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", ffesta_tokens[0]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t,
+						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
+}
+
+/* ffestb_V0261_ -- "FIND" OPEN_PAREN
+
+   return ffestb_V0261_;  // to lexer
+
+   Handle expr construct (not NAME=expr construct) here.  */
+
+static ffelexHandler
+ffestb_V0261_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      ffesta_tokens[1] = ffelex_token_use (t);
+      return (ffelexHandler) ffestb_V0262_;
+
+    default:
+      return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+		  FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0263_)))
+	(t);
+    }
+}
+
+/* ffestb_V0262_ -- "FIND" OPEN_PAREN NAME
+
+   return ffestb_V0262_;  // to lexer
+
+   If EQUALS here, go to states that handle it.	 Else, send NAME and this
+   token thru expression handler.  */
+
+static ffelexHandler
+ffestb_V0262_ (ffelexToken t)
+{
+  ffelexHandler next;
+  ffelexToken nt;
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEQUALS:
+      nt = ffesta_tokens[1];
+      next = (ffelexHandler) ffestb_V0264_ (nt);
+      ffelex_token_kill (nt);
+      return (ffelexHandler) (*next) (t);
+
+    default:
+      next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+		  FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0263_)))
+	(ffesta_tokens[1]);
+      ffelex_token_kill (ffesta_tokens[1]);
+      return (ffelexHandler) (*next) (t);
+    }
+}
+
+/* ffestb_V0263_ -- "FIND" OPEN_PAREN expr
+
+   (ffestb_V0263_)  // to expression handler
+
+   Handle COMMA or FIND_PAREN here.  */
+
+static ffelexHandler
+ffestb_V0263_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeCLOSE_PAREN:
+      if (expr == NULL)
+	break;
+      ffestp_file.find.find_spec[FFESTP_findixUNIT].kw_or_val_present
+	= TRUE;
+      ffestp_file.find.find_spec[FFESTP_findixUNIT].kw_present = FALSE;
+      ffestp_file.find.find_spec[FFESTP_findixUNIT].value_present = TRUE;
+      ffestp_file.find.find_spec[FFESTP_findixUNIT].value_is_label
+	= FALSE;
+      ffestp_file.find.find_spec[FFESTP_findixUNIT].value
+	= ffelex_token_use (ft);
+      ffestp_file.find.find_spec[FFESTP_findixUNIT].u.expr = expr;
+      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+	return (ffelexHandler) ffestb_V0264_;
+      return (ffelexHandler) ffestb_V0269_;
+
+    default:
+      break;
+    }
+
+  ffestb_subr_kill_find_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0264_ -- "FIND" OPEN_PAREN [external-file-unit COMMA]
+
+   return ffestb_V0264_;  // to lexer
+
+   Handle expr construct (not NAME=expr construct) here.  */
+
+static ffelexHandler
+ffestb_V0264_ (ffelexToken t)
+{
+  ffestrGenio kw;
+
+  ffestb_local_.find.label = FALSE;
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      kw = ffestr_genio (t);
+      switch (kw)
+	{
+	case FFESTR_genioERR:
+	  ffestb_local_.find.ix = FFESTP_findixERR;
+	  ffestb_local_.find.label = TRUE;
+	  break;
+
+	case FFESTR_genioIOSTAT:
+	  ffestb_local_.find.ix = FFESTP_findixIOSTAT;
+	  ffestb_local_.find.left = TRUE;
+	  ffestb_local_.find.context = FFEEXPR_contextFILEINT;
+	  break;
+
+	case FFESTR_genioREC:
+	  ffestb_local_.find.ix = FFESTP_findixREC;
+	  ffestb_local_.find.left = FALSE;
+	  ffestb_local_.find.context = FFEEXPR_contextFILENUM;
+	  break;
+
+	case FFESTR_genioUNIT:
+	  ffestb_local_.find.ix = FFESTP_findixUNIT;
+	  ffestb_local_.find.left = FALSE;
+	  ffestb_local_.find.context = FFEEXPR_contextFILENUM;
+	  break;
+
+	default:
+	  goto bad;		/* :::::::::::::::::::: */
+	}
+      if (ffestp_file.find.find_spec[ffestb_local_.find.ix]
+	  .kw_or_val_present)
+	break;			/* Can't specify a keyword twice! */
+      ffestp_file.find.find_spec[ffestb_local_.find.ix]
+	.kw_or_val_present = TRUE;
+      ffestp_file.find.find_spec[ffestb_local_.find.ix]
+	.kw_present = TRUE;
+      ffestp_file.find.find_spec[ffestb_local_.find.ix]
+	.value_present = FALSE;
+      ffestp_file.find.find_spec[ffestb_local_.find.ix].value_is_label
+	= ffestb_local_.find.label;
+      ffestp_file.find.find_spec[ffestb_local_.find.ix].kw
+	= ffelex_token_use (t);
+      return (ffelexHandler) ffestb_V0265_;
+
+    default:
+      break;
+    }
+
+bad:				/* :::::::::::::::::::: */
+  ffestb_subr_kill_find_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0265_ -- "FIND" OPEN_PAREN [external-file-unit COMMA] NAME
+
+   return ffestb_V0265_;  // to lexer
+
+   Make sure EQUALS here, send next token to expression handler.  */
+
+static ffelexHandler
+ffestb_V0265_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEQUALS:
+      ffesta_confirmed ();
+      if (ffestb_local_.find.label)
+	return (ffelexHandler) ffestb_V0267_;
+      if (ffestb_local_.find.left)
+	return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+					    ffestb_local_.find.context,
+					    (ffeexprCallback) ffestb_V0266_);
+      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+					  ffestb_local_.find.context,
+					  (ffeexprCallback) ffestb_V0266_);
+
+    default:
+      break;
+    }
+
+  ffestb_subr_kill_find_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0266_ -- "FIND" OPEN_PAREN ... NAME EQUALS expr
+
+   (ffestb_V0266_)  // to expression handler
+
+   Handle COMMA or CLOSE_PAREN here.  */
+
+static ffelexHandler
+ffestb_V0266_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeCLOSE_PAREN:
+      if (expr == NULL)
+	break;
+      ffestp_file.find.find_spec[ffestb_local_.find.ix].value_present
+	= TRUE;
+      ffestp_file.find.find_spec[ffestb_local_.find.ix].value
+	= ffelex_token_use (ft);
+      ffestp_file.find.find_spec[ffestb_local_.find.ix].u.expr = expr;
+      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+	return (ffelexHandler) ffestb_V0264_;
+      return (ffelexHandler) ffestb_V0269_;
+
+    default:
+      break;
+    }
+
+  ffestb_subr_kill_find_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0267_ -- "FIND" OPEN_PAREN ... NAME EQUALS
+
+   return ffestb_V0267_;  // to lexer
+
+   Handle NUMBER for label here.  */
+
+static ffelexHandler
+ffestb_V0267_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNUMBER:
+      ffestp_file.find.find_spec[ffestb_local_.find.ix].value_present
+	= TRUE;
+      ffestp_file.find.find_spec[ffestb_local_.find.ix].value
+	= ffelex_token_use (t);
+      return (ffelexHandler) ffestb_V0268_;
+
+    default:
+      break;
+    }
+
+  ffestb_subr_kill_find_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0268_ -- "FIND" OPEN_PAREN ... NAME EQUALS NUMBER
+
+   return ffestb_V0268_;  // to lexer
+
+   Handle COMMA or CLOSE_PAREN here.  */
+
+static ffelexHandler
+ffestb_V0268_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+      return (ffelexHandler) ffestb_V0264_;
+
+    case FFELEX_typeCLOSE_PAREN:
+      return (ffelexHandler) ffestb_V0269_;
+
+    default:
+      break;
+    }
+
+  ffestb_subr_kill_find_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0269_ -- "FIND" OPEN_PAREN ... CLOSE_PAREN
+
+   return ffestb_V0269_;  // to lexer
+
+   Handle EOS or SEMICOLON here.  */
+
+static ffelexHandler
+ffestb_V0269_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      ffesta_confirmed ();
+      if (!ffesta_is_inhibited ())
+	ffestc_V026 ();
+      ffestb_subr_kill_find_ ();
+      return (ffelexHandler) ffesta_zero (t);
+
+    default:
+      break;
+    }
+
+  ffestb_subr_kill_find_ ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_dimlist -- Parse the ALLOCATABLE/POINTER/TARGET statement
+
+   return ffestb_dimlist;  // to lexer
+
+   Make sure the statement has a valid form for the ALLOCATABLE/POINTER/
+   TARGET statement.  If it does, implement the statement.  */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_dimlist (ffelexToken t)
+{
+  ffeTokenLength i;
+  char *p;
+  ffelexToken nt;
+  ffelexHandler next;
+
+  switch (ffelex_token_type (ffesta_tokens[0]))
+    {
+    case FFELEX_typeNAME:
+      switch (ffelex_token_type (t))
+	{
+	case FFELEX_typeCOMMA:
+	case FFELEX_typeEOS:
+	case FFELEX_typeSEMICOLON:
+	  ffesta_confirmed ();	/* Error, but clearly intended. */
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	default:
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	case FFELEX_typeCOLONCOLON:
+	  ffesta_confirmed ();
+	  if (!ffesta_is_inhibited ())
+	    {
+	      switch (ffesta_first_kw)
+		{
+		case FFESTR_firstALLOCATABLE:
+		  ffestc_R525_start ();
+		  break;
+
+		case FFESTR_firstPOINTER:
+		  ffestc_R526_start ();
+		  break;
+
+		case FFESTR_firstTARGET:
+		  ffestc_R527_start ();
+		  break;
+
+		default:
+		  assert (FALSE);
+		}
+	    }
+	  ffestb_local_.dimlist.started = TRUE;
+	  return (ffelexHandler) ffestb_dimlist1_;
+
+	case FFELEX_typeNAME:
+	  ffesta_confirmed ();
+	  if (!ffesta_is_inhibited ())
+	    {
+	      switch (ffesta_first_kw)
+		{
+		case FFESTR_firstALLOCATABLE:
+		  ffestc_R525_start ();
+		  break;
+
+		case FFESTR_firstPOINTER:
+		  ffestc_R526_start ();
+		  break;
+
+		case FFESTR_firstTARGET:
+		  ffestc_R527_start ();
+		  break;
+
+		default:
+		  assert (FALSE);
+		}
+	    }
+	  ffestb_local_.dimlist.started = TRUE;
+	  return (ffelexHandler) ffestb_dimlist1_ (t);
+	}
+
+    case FFELEX_typeNAMES:
+      p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.dimlist.len);
+      switch (ffelex_token_type (t))
+	{
+	default:
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	case FFELEX_typeEOS:
+	case FFELEX_typeSEMICOLON:
+	case FFELEX_typeCOMMA:
+	  ffesta_confirmed ();
+	  if (!ffesrc_is_name_init (*p))
+	    goto bad_i;		/* :::::::::::::::::::: */
+	  nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+	  if (!ffesta_is_inhibited ())
+	    {
+	      switch (ffesta_first_kw)
+		{
+		case FFESTR_firstALLOCATABLE:
+		  ffestc_R525_start ();
+		  break;
+
+		case FFESTR_firstPOINTER:
+		  ffestc_R526_start ();
+		  break;
+
+		case FFESTR_firstTARGET:
+		  ffestc_R527_start ();
+		  break;
+
+		default:
+		  assert (FALSE);
+		}
+	    }
+	  ffestb_local_.dimlist.started = TRUE;
+	  next = (ffelexHandler) ffestb_dimlist1_ (nt);
+	  ffelex_token_kill (nt);
+	  return (ffelexHandler) (*next) (t);
+
+	case FFELEX_typeCOLONCOLON:
+	  ffesta_confirmed ();
+	  if (*p != '\0')
+	    goto bad_i;		/* :::::::::::::::::::: */
+	  if (!ffesta_is_inhibited ())
+	    {
+	      switch (ffesta_first_kw)
+		{
+		case FFESTR_firstALLOCATABLE:
+		  ffestc_R525_start ();
+		  break;
+
+		case FFESTR_firstPOINTER:
+		  ffestc_R526_start ();
+		  break;
+
+		case FFESTR_firstTARGET:
+		  ffestc_R527_start ();
+		  break;
+
+		default:
+		  assert (FALSE);
+		}
+	    }
+	  ffestb_local_.dimlist.started = TRUE;
+	  return (ffelexHandler) ffestb_dimlist1_;
+
+	case FFELEX_typeOPEN_PAREN:
+	  if (!ffesrc_is_name_init (*p))
+	    goto bad_i;		/* :::::::::::::::::::: */
+	  nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+	  ffestb_local_.dimlist.started = FALSE;
+	  next = (ffelexHandler) ffestb_dimlist1_ (nt);
+	  ffelex_token_kill (nt);
+	  return (ffelexHandler) (*next) (t);
+	}
+
+    default:
+      goto bad_0;		/* :::::::::::::::::::: */
+    }
+
+bad_0:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, ffesta_tokens[0]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t,
+						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
+
+bad_i:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, ffesta_tokens[0], i, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_dimlist1_ -- "ALLOCATABLE/POINTER/TARGET" [COLONCOLON]
+
+   return ffestb_dimlist1_;  // to lexer
+
+   Handle NAME.	 */
+
+static ffelexHandler
+ffestb_dimlist1_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      ffesta_tokens[1] = ffelex_token_use (t);
+      return (ffelexHandler) ffestb_dimlist2_;
+
+    default:
+      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
+      break;
+    }
+
+  if (!ffesta_is_inhibited ())
+    {
+      switch (ffesta_first_kw)
+	{
+	case FFESTR_firstALLOCATABLE:
+	  ffestc_R525_finish ();
+	  break;
+
+	case FFESTR_firstPOINTER:
+	  ffestc_R526_finish ();
+	  break;
+
+	case FFESTR_firstTARGET:
+	  ffestc_R527_finish ();
+	  break;
+
+	default:
+	  assert (FALSE);
+	}
+    }
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_dimlist2_ -- "ALLOCATABLE/POINTER/TARGET" ... NAME
+
+   return ffestb_dimlist2_;  // to lexer
+
+   Handle OPEN_PAREN.  */
+
+static ffelexHandler
+ffestb_dimlist2_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeOPEN_PAREN:
+      ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
+      ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_dimlist3_;
+      ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
+      ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLIST;
+#ifdef FFECOM_dimensionsMAX
+      ffestb_subrargs_.dim_list.ndims = 0;
+#endif
+      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+	    FFEEXPR_contextDIMLIST, (ffeexprCallback) ffestb_subr_dimlist_);
+
+    case FFELEX_typeCOMMA:
+      ffesta_confirmed ();
+      if (!ffesta_is_inhibited ())
+	{
+	  if (!ffestb_local_.dimlist.started)
+	    {
+	      switch (ffesta_first_kw)
+		{
+		case FFESTR_firstALLOCATABLE:
+		  ffestc_R525_start ();
+		  break;
+
+		case FFESTR_firstPOINTER:
+		  ffestc_R526_start ();
+		  break;
+
+		case FFESTR_firstTARGET:
+		  ffestc_R527_start ();
+		  break;
+
+		default:
+		  assert (FALSE);
+		}
+	      ffestb_local_.dimlist.started = TRUE;
+	    }
+	  switch (ffesta_first_kw)
+	    {
+	    case FFESTR_firstALLOCATABLE:
+	      ffestc_R525_item (ffesta_tokens[1], NULL);
+	      break;
+
+	    case FFESTR_firstPOINTER:
+	      ffestc_R526_item (ffesta_tokens[1], NULL);
+	      break;
+
+	    case FFESTR_firstTARGET:
+	      ffestc_R527_item (ffesta_tokens[1], NULL);
+	      break;
+
+	    default:
+	      assert (FALSE);
+	    }
+	}
+      ffelex_token_kill (ffesta_tokens[1]);
+      return (ffelexHandler) ffestb_dimlist4_;
+
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      ffesta_confirmed ();
+      if (!ffesta_is_inhibited ())
+	{
+	  if (!ffestb_local_.dimlist.started)
+	    {
+	      switch (ffesta_first_kw)
+		{
+		case FFESTR_firstALLOCATABLE:
+		  ffestc_R525_start ();
+		  break;
+
+		case FFESTR_firstPOINTER:
+		  ffestc_R526_start ();
+		  break;
+
+		case FFESTR_firstTARGET:
+		  ffestc_R527_start ();
+		  break;
+
+		default:
+		  assert (FALSE);
+		}
+	    }
+	  switch (ffesta_first_kw)
+	    {
+	    case FFESTR_firstALLOCATABLE:
+	      ffestc_R525_item (ffesta_tokens[1], NULL);
+	      ffestc_R525_finish ();
+	      break;
+
+	    case FFESTR_firstPOINTER:
+	      ffestc_R526_item (ffesta_tokens[1], NULL);
+	      ffestc_R526_finish ();
+	      break;
+
+	    case FFESTR_firstTARGET:
+	      ffestc_R527_item (ffesta_tokens[1], NULL);
+	      ffestc_R527_finish ();
+	      break;
+
+	    default:
+	      assert (FALSE);
+	    }
+	}
+      ffelex_token_kill (ffesta_tokens[1]);
+      return (ffelexHandler) ffesta_zero (t);
+
+    default:
+      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
+      break;
+    }
+
+  if (!ffesta_is_inhibited ())
+    {
+      switch (ffesta_first_kw)
+	{
+	case FFESTR_firstALLOCATABLE:
+	  ffestc_R525_finish ();
+	  break;
+
+	case FFESTR_firstPOINTER:
+	  ffestc_R526_finish ();
+	  break;
+
+	case FFESTR_firstTARGET:
+	  ffestc_R527_finish ();
+	  break;
+
+	default:
+	  assert (FALSE);
+	}
+    }
+  ffelex_token_kill (ffesta_tokens[1]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_dimlist3_ -- "ALLOCATABLE/POINTER/TARGET" ... NAME OPEN_PAREN
+		       dimlist CLOSE_PAREN
+
+   return ffestb_dimlist3_;  // to lexer
+
+   Handle COMMA or EOS/SEMICOLON.  */
+
+static ffelexHandler
+ffestb_dimlist3_ (ffelexToken t)
+{
+  if (!ffestb_subrargs_.dim_list.ok)
+    goto bad;			/* :::::::::::::::::::: */
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+      ffesta_confirmed ();
+      if (!ffesta_is_inhibited ())
+	{
+	  if (!ffestb_local_.dimlist.started)
+	    {
+	      switch (ffesta_first_kw)
+		{
+		case FFESTR_firstALLOCATABLE:
+		  ffestc_R525_start ();
+		  break;
+
+		case FFESTR_firstPOINTER:
+		  ffestc_R526_start ();
+		  break;
+
+		case FFESTR_firstTARGET:
+		  ffestc_R527_start ();
+		  break;
+
+		default:
+		  assert (FALSE);
+		}
+	      ffestb_local_.dimlist.started = TRUE;
+	    }
+	  switch (ffesta_first_kw)
+	    {
+	    case FFESTR_firstALLOCATABLE:
+	      ffestc_R525_item (ffesta_tokens[1],
+				ffestb_subrargs_.dim_list.dims);
+	      break;
+
+	    case FFESTR_firstPOINTER:
+	      ffestc_R526_item (ffesta_tokens[1],
+				ffestb_subrargs_.dim_list.dims);
+	      break;
+
+	    case FFESTR_firstTARGET:
+	      ffestc_R527_item (ffesta_tokens[1],
+				ffestb_subrargs_.dim_list.dims);
+	      break;
+
+	    default:
+	      assert (FALSE);
+	    }
+	}
+      ffelex_token_kill (ffesta_tokens[1]);
+      ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+      return (ffelexHandler) ffestb_dimlist4_;
+
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      ffesta_confirmed ();
+      if (!ffesta_is_inhibited ())
+	{
+	  if (!ffestb_local_.dimlist.started)
+	    {
+	      switch (ffesta_first_kw)
+		{
+		case FFESTR_firstALLOCATABLE:
+		  ffestc_R525_start ();
+		  break;
+
+		case FFESTR_firstPOINTER:
+		  ffestc_R526_start ();
+		  break;
+
+		case FFESTR_firstTARGET:
+		  ffestc_R527_start ();
+		  break;
+
+		default:
+		  assert (FALSE);
+		}
+	    }
+	  switch (ffesta_first_kw)
+	    {
+	    case FFESTR_firstALLOCATABLE:
+	      ffestc_R525_item (ffesta_tokens[1],
+				ffestb_subrargs_.dim_list.dims);
+	      ffestc_R525_finish ();
+	      break;
+
+	    case FFESTR_firstPOINTER:
+	      ffestc_R526_item (ffesta_tokens[1],
+				ffestb_subrargs_.dim_list.dims);
+	      ffestc_R526_finish ();
+	      break;
+
+	    case FFESTR_firstTARGET:
+	      ffestc_R527_item (ffesta_tokens[1],
+				ffestb_subrargs_.dim_list.dims);
+	      ffestc_R527_finish ();
+	      break;
+
+	    default:
+	      assert (FALSE);
+	    }
+	}
+      ffelex_token_kill (ffesta_tokens[1]);
+      ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+      return (ffelexHandler) ffesta_zero (t);
+
+    default:
+      break;
+    }
+
+bad:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
+  if (ffestb_local_.dimlist.started && !ffesta_is_inhibited ())
+    {
+      switch (ffesta_first_kw)
+	{
+	case FFESTR_firstALLOCATABLE:
+	  ffestc_R525_finish ();
+	  break;
+
+	case FFESTR_firstPOINTER:
+	  ffestc_R526_finish ();
+	  break;
+
+	case FFESTR_firstTARGET:
+	  ffestc_R527_finish ();
+	  break;
+
+	default:
+	  assert (FALSE);
+	}
+    }
+  ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+  ffelex_token_kill (ffesta_tokens[1]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_dimlist4_ -- "ALLOCATABLE/POINTER/TARGET" ... COMMA
+
+   return ffestb_dimlist4_;  // to lexer
+
+   Make sure we don't have EOS or SEMICOLON.  */
+
+static ffelexHandler
+ffestb_dimlist4_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      if (!ffesta_is_inhibited ())
+	{
+	  switch (ffesta_first_kw)
+	    {
+	    case FFESTR_firstALLOCATABLE:
+	      ffestc_R525_finish ();
+	      break;
+
+	    case FFESTR_firstPOINTER:
+	      ffestc_R526_finish ();
+	      break;
+
+	    case FFESTR_firstTARGET:
+	      ffestc_R527_finish ();
+	      break;
+
+	    default:
+	      assert (FALSE);
+	    }
+	}
+      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
+      return (ffelexHandler) ffesta_zero (t);
+
+    default:
+      return (ffelexHandler) ffestb_dimlist1_ (t);
+    }
+}
+
+#endif
+/* ffestb_dummy -- Parse an ENTRY/FUNCTION/SUBROUTINE statement
+
+   return ffestb_dummy;	 // to lexer
+
+   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;
+  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;
+  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;
+  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_R624 -- Parse a NULLIFY statement
+
+   return ffestb_R624;	// to lexer
+
+   Make sure the statement has a valid form for a NULLIFY
+   statement.  If it does, implement the statement.
+
+   31-May-90  JCB  2.0
+      Rewrite to produce a list of expressions rather than just names; this
+      eases semantic checking, putting it in expression handling where that
+      kind of thing gets done anyway, and makes it easier to support more
+      flexible extensions to Fortran 90 like NULLIFY(FOO%BAR).	*/
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_R624 (ffelexToken t)
+{
+  switch (ffelex_token_type (ffesta_tokens[0]))
+    {
+    case FFELEX_typeNAME:
+      if (ffesta_first_kw != FFESTR_firstNULLIFY)
+	goto bad_0;		/* :::::::::::::::::::: */
+      break;
+
+    case FFELEX_typeNAMES:
+      if (ffesta_first_kw != FFESTR_firstNULLIFY)
+	goto bad_0;		/* :::::::::::::::::::: */
+      if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlNULLIFY)
+	goto bad_0;		/* :::::::::::::::::::: */
+      break;
+
+    default:
+      goto bad_0;		/* :::::::::::::::::::: */
+    }
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeOPEN_PAREN:
+      break;
+
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeCOLONCOLON:
+    case FFELEX_typeNAME:
+      ffesta_confirmed ();	/* Error, but clearly intended. */
+      goto bad_1;		/* :::::::::::::::::::: */
+
+    default:
+      goto bad_1;		/* :::::::::::::::::::: */
+    }
+
+  ffestb_local_.R624.exprs = ffestt_exprlist_create ();
+  return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+				      FFEEXPR_contextNULLIFY,
+				      (ffeexprCallback) ffestb_R6241_);
+
+bad_0:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", ffesta_tokens[0]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t,
+						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
+}
+
+/* ffestb_R6241_ -- "NULLIFY" OPEN_PAREN expr
+
+   return ffestb_R6241_;  // to lexer
+
+   Make sure the statement has a valid form for a NULLIFY statement.  If it
+   does, implement the statement.
+
+   31-May-90  JCB  2.0
+      Rewrite to produce a list of expressions rather than just names; this
+      eases semantic checking, putting it in expression handling where that
+      kind of thing gets done anyway, and makes it easier to support more
+      flexible extensions to Fortran 90 like NULLIFY(FOO%BAR).	*/
+
+static ffelexHandler
+ffestb_R6241_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCLOSE_PAREN:
+      if (expr == NULL)
+	break;
+      ffestt_exprlist_append (ffestb_local_.R624.exprs, expr,
+			      ffelex_token_use (t));
+      return (ffelexHandler) ffestb_R6242_;
+
+    case FFELEX_typeCOMMA:
+      if (expr == NULL)
+	break;
+      ffestt_exprlist_append (ffestb_local_.R624.exprs, expr,
+			      ffelex_token_use (t));
+      return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+					  FFEEXPR_contextNULLIFY,
+					  (ffeexprCallback) ffestb_R6241_);
+
+    default:
+      break;
+    }
+
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", t);
+  ffestt_exprlist_kill (ffestb_local_.R624.exprs);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R6242_ -- "NULLIFY" OPEN_PAREN expr-list CLOSE_PAREN
+
+   return ffestb_R6242_;  // to lexer
+
+   Make sure the statement has a valid form for a NULLIFY statement.  If it
+   does, implement the statement.  */
+
+static ffelexHandler
+ffestb_R6242_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      ffesta_confirmed ();
+      if (!ffesta_is_inhibited ())
+	ffestc_R624 (ffestb_local_.R624.exprs);
+      ffestt_exprlist_kill (ffestb_local_.R624.exprs);
+      return (ffelexHandler) ffesta_zero (t);
+
+    default:
+      break;
+    }
+
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", t);
+  ffestt_exprlist_kill (ffestb_local_.R624.exprs);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_R1229 -- Parse a STMTFUNCTION statement
+
+   return ffestb_R1229;	 // to lexer
+
+   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;
+  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;
+  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;
+  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_recursive -- Parse the RECURSIVE FUNCTION statement
+
+   return ffestb_decl_recursive;  // to lexer
+
+   Make sure the statement has a valid form for the RECURSIVE FUNCTION
+   statement.  If it does, implement the statement.  */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_decl_recursive (ffelexToken t)
+{
+  ffeTokenLength i;
+  char *p;
+  ffelexToken nt;
+  ffelexToken ot;
+  ffelexHandler next;
+  bool needfunc;
+
+  switch (ffelex_token_type (ffesta_tokens[0]))
+    {
+    case FFELEX_typeNAME:
+      if (ffesta_first_kw != FFESTR_firstRECURSIVE)
+	goto bad_0;		/* :::::::::::::::::::: */
+      switch (ffelex_token_type (t))
+	{
+	case FFELEX_typeEOS:
+	case FFELEX_typeSEMICOLON:
+	case FFELEX_typeCOMMA:
+	case FFELEX_typeCOLONCOLON:
+	  ffesta_confirmed ();	/* Error, but clearly intended. */
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	default:
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	case FFELEX_typeNAME:
+	  break;
+	}
+      ffesta_confirmed ();
+      ffestb_local_.decl.recursive = ffelex_token_use (ffesta_tokens[0]);
+      switch (ffesta_second_kw)
+	{
+	case FFESTR_secondINTEGER:
+	  ffestb_local_.decl.type = FFESTP_typeINTEGER;
+	  return (ffelexHandler) ffestb_decl_recursive1_;
+
+	case FFESTR_secondBYTE:
+	  ffestb_local_.decl.type = FFESTP_typeBYTE;
+	  return (ffelexHandler) ffestb_decl_recursive1_;
+
+	case FFESTR_secondWORD:
+	  ffestb_local_.decl.type = FFESTP_typeWORD;
+	  return (ffelexHandler) ffestb_decl_recursive1_;
+
+	case FFESTR_secondREAL:
+	  ffestb_local_.decl.type = FFESTP_typeREAL;
+	  return (ffelexHandler) ffestb_decl_recursive1_;
+
+	case FFESTR_secondCOMPLEX:
+	  ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
+	  return (ffelexHandler) ffestb_decl_recursive1_;
+
+	case FFESTR_secondLOGICAL:
+	  ffestb_local_.decl.type = FFESTP_typeLOGICAL;
+	  return (ffelexHandler) ffestb_decl_recursive1_;
+
+	case FFESTR_secondCHARACTER:
+	  ffestb_local_.decl.type = FFESTP_typeCHARACTER;
+	  return (ffelexHandler) ffestb_decl_recursive1_;
+
+	case FFESTR_secondDOUBLE:
+	  return (ffelexHandler) ffestb_decl_recursive2_;
+
+	case FFESTR_secondDOUBLEPRECISION:
+	  ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
+	  ffestb_local_.decl.kind = NULL;
+	  ffestb_local_.decl.kindt = NULL;
+	  ffestb_local_.decl.len = NULL;
+	  ffestb_local_.decl.lent = NULL;
+	  return (ffelexHandler) ffestb_decl_func_;
+
+	case FFESTR_secondDOUBLECOMPLEX:
+	  ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
+	  ffestb_local_.decl.kind = NULL;
+	  ffestb_local_.decl.kindt = NULL;
+	  ffestb_local_.decl.len = NULL;
+	  ffestb_local_.decl.lent = NULL;
+	  return (ffelexHandler) ffestb_decl_func_;
+
+	case FFESTR_secondTYPE:
+	  ffestb_local_.decl.type = FFESTP_typeTYPE;
+	  return (ffelexHandler) ffestb_decl_recursive3_;
+
+	case FFESTR_secondFUNCTION:
+	  ffestb_local_.dummy.first_kw = FFESTR_firstFUNCTION;
+	  ffestb_local_.dummy.badname = "FUNCTION";
+	  ffestb_local_.dummy.is_subr = FALSE;
+	  return (ffelexHandler) ffestb_decl_recursive4_;
+
+	case FFESTR_secondSUBROUTINE:
+	  ffestb_local_.dummy.first_kw = FFESTR_firstSUBROUTINE;
+	  ffestb_local_.dummy.badname = "SUBROUTINE";
+	  ffestb_local_.dummy.is_subr = TRUE;
+	  return (ffelexHandler) ffestb_decl_recursive4_;
+
+	default:
+	  ffelex_token_kill (ffestb_local_.decl.recursive);
+	  goto bad_1;		/* :::::::::::::::::::: */
+	}
+
+    case FFELEX_typeNAMES:
+      if (ffesta_first_kw != FFESTR_firstRECURSIVE)
+	goto bad_0;		/* :::::::::::::::::::: */
+      switch (ffelex_token_type (t))
+	{
+	case FFELEX_typeCOMMA:
+	case FFELEX_typeCOLONCOLON:
+	case FFELEX_typeASTERISK:
+	case FFELEX_typeSEMICOLON:
+	case FFELEX_typeEOS:
+	  ffesta_confirmed ();
+	  break;
+
+	default:
+	  break;
+	}
+      p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlRECURSIVE);
+      if (!ffesrc_is_name_init (*p))
+	goto bad_0;		/* :::::::::::::::::::: */
+      ffestb_local_.decl.recursive
+	= ffelex_token_name_from_names (ffesta_tokens[0], 0,
+					FFESTR_firstlRECURSIVE);
+      nt = ffelex_token_names_from_names (ffesta_tokens[0],
+					  FFESTR_firstlRECURSIVE, 0);
+      switch (ffestr_first (nt))
+	{
+	case FFESTR_firstINTGR:
+	  p = ffelex_token_text (nt) + (i = FFESTR_firstlINTGR);
+	  ffestb_local_.decl.type = FFESTP_typeINTEGER;
+	  needfunc = FALSE;
+	  goto typefunc;	/* :::::::::::::::::::: */
+
+	case FFESTR_firstBYTE:
+	  p = ffelex_token_text (nt) + (i = FFESTR_firstlBYTE);
+	  ffestb_local_.decl.type = FFESTP_typeBYTE;
+	  needfunc = FALSE;
+	  goto typefunc;	/* :::::::::::::::::::: */
+
+	case FFESTR_firstWORD:
+	  p = ffelex_token_text (nt) + (i = FFESTR_firstlWORD);
+	  ffestb_local_.decl.type = FFESTP_typeWORD;
+	  needfunc = FALSE;
+	  goto typefunc;	/* :::::::::::::::::::: */
+
+	case FFESTR_firstREAL:
+	  p = ffelex_token_text (nt) + (i = FFESTR_firstlREAL);
+	  ffestb_local_.decl.type = FFESTP_typeREAL;
+	  needfunc = FALSE;
+	  goto typefunc;	/* :::::::::::::::::::: */
+
+	case FFESTR_firstCMPLX:
+	  p = ffelex_token_text (nt) + (i = FFESTR_firstlCMPLX);
+	  ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
+	  needfunc = FALSE;
+	  goto typefunc;	/* :::::::::::::::::::: */
+
+	case FFESTR_firstLGCL:
+	  p = ffelex_token_text (nt) + (i = FFESTR_firstlLGCL);
+	  ffestb_local_.decl.type = FFESTP_typeLOGICAL;
+	  needfunc = FALSE;
+	  goto typefunc;	/* :::::::::::::::::::: */
+
+	case FFESTR_firstCHRCTR:
+	  p = ffelex_token_text (nt) + (i = FFESTR_firstlCHRCTR);
+	  ffestb_local_.decl.type = FFESTP_typeCHARACTER;
+	  needfunc = FALSE;
+	  goto typefunc;	/* :::::::::::::::::::: */
+
+	case FFESTR_firstDBLPRCSN:
+	  p = ffelex_token_text (nt) + (i = FFESTR_firstlDBLPRCSN);
+	  ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
+	  needfunc = TRUE;
+	  goto typefunc;	/* :::::::::::::::::::: */
+
+	case FFESTR_firstDBLCMPLX:
+	  p = ffelex_token_text (nt) + (i = FFESTR_firstlDBLCMPLX);
+	  ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
+	  needfunc = TRUE;
+	  goto typefunc;	/* :::::::::::::::::::: */
+
+	case FFESTR_firstTYPE:
+	  p = ffelex_token_text (nt) + (i = FFESTR_firstlTYPE);
+	  ffestb_local_.decl.type = FFESTP_typeTYPE;
+	  next = (ffelexHandler) ffestb_decl_recursive3_;
+	  break;
+
+	case FFESTR_firstFUNCTION:
+	  p = ffelex_token_text (nt) + (i = FFESTR_firstlFUNCTION);
+	  ffestb_local_.dummy.first_kw = FFESTR_firstFUNCTION;
+	  ffestb_local_.dummy.badname = "FUNCTION";
+	  ffestb_local_.dummy.is_subr = FALSE;
+	  next = (ffelexHandler) ffestb_decl_recursive4_;
+	  break;
+
+	case FFESTR_firstSUBROUTINE:
+	  p = ffelex_token_text (nt) + (i = FFESTR_firstlSUBROUTINE);
+	  ffestb_local_.dummy.first_kw = FFESTR_firstSUBROUTINE;
+	  ffestb_local_.dummy.badname = "SUBROUTINE";
+	  ffestb_local_.dummy.is_subr = TRUE;
+	  next = (ffelexHandler) ffestb_decl_recursive4_;
+	  break;
+
+	default:
+	  ffelex_token_kill (ffestb_local_.decl.recursive);
+	  ffelex_token_kill (nt);
+	  goto bad_1;		/* :::::::::::::::::::: */
+	}
+      if (*p == '\0')
+	{
+	  ffelex_token_kill (nt);
+	  return (ffelexHandler) (*next) (t);
+	}
+      if (!ffesrc_is_name_init (*p))
+	goto bad_i;		/* :::::::::::::::::::: */
+      ot = ffelex_token_name_from_names (nt, i, 0);
+      ffelex_token_kill (nt);
+      next = (ffelexHandler) (*next) (ot);
+      ffelex_token_kill (ot);
+      return (ffelexHandler) (*next) (t);
+
+    default:
+      goto bad_0;		/* :::::::::::::::::::: */
+    }
+
+typefunc:			/* :::::::::::::::::::: */
+  if (*p == '\0')
+    {
+      ffelex_token_kill (nt);
+      if (needfunc)		/* DOUBLE PRECISION or DOUBLE COMPLEX? */
+	{
+	  ffelex_token_kill (ffestb_local_.decl.recursive);
+	  goto bad_1;		/* :::::::::::::::::::: */
+	}
+      return (ffelexHandler) ffestb_decl_recursive1_ (t);
+    }
+  if (!ffesrc_is_name_init (*p))
+    goto bad_i;			/* :::::::::::::::::::: */
+  ot = ffelex_token_names_from_names (nt, i, 0);
+  ffelex_token_kill (nt);
+  if (ffestr_first (ot) != FFESTR_firstFUNCTION)
+    goto bad_o;			/* :::::::::::::::::::: */
+  p = ffelex_token_text (ot) + (i = FFESTR_firstlFUNCTION);
+  if (!ffesrc_is_name_init (*p))
+    goto bad_i;			/* :::::::::::::::::::: */
+  ffesta_tokens[1] = ffelex_token_name_from_names (ot, i, 0);
+  ffelex_token_kill (ot);
+  ffestb_local_.decl.kind = NULL;
+  ffestb_local_.decl.kindt = NULL;
+  ffestb_local_.decl.len = NULL;
+  ffestb_local_.decl.lent = NULL;
+  return (ffelexHandler) ffestb_decl_funcname_1_ (t);
+
+bad_0:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", ffesta_tokens[0]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t,
+						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
+
+bad_i:				/* :::::::::::::::::::: */
+  ffelex_token_kill (ffestb_local_.decl.recursive);
+  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", nt, i, t);
+  ffelex_token_kill (nt);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_o:				/* :::::::::::::::::::: */
+  ffelex_token_kill (ffestb_local_.decl.recursive);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", ot);
+  ffelex_token_kill (ot);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_recursive1_ -- "RECURSIVE" generic-type
+
+   return ffestb_decl_recursive1_;  // to lexer
+
+   Handle ASTERISK, OPEN_PAREN, or NAME.  */
+
+static ffelexHandler
+ffestb_decl_recursive1_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeASTERISK:
+      ffesta_confirmed ();
+      ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_func_;
+      ffestb_local_.decl.badname = "TYPEFUNC";
+      if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
+	return (ffelexHandler) ffestb_decl_starlen_;
+      return (ffelexHandler) ffestb_decl_starkind_;
+
+    case FFELEX_typeOPEN_PAREN:
+      ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_func_;
+      ffestb_local_.decl.badname = "TYPEFUNC";
+      if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
+	{
+	  ffestb_local_.decl.kind = NULL;
+	  ffestb_local_.decl.kindt = NULL;
+	  ffestb_local_.decl.len = NULL;
+	  ffestb_local_.decl.lent = NULL;
+	  return (ffelexHandler) ffestb_decl_typeparams_;
+	}
+      return (ffelexHandler) ffestb_decl_kindparam_;
+
+    case FFELEX_typeNAME:
+      ffestb_local_.decl.kind = NULL;
+      ffestb_local_.decl.kindt = NULL;
+      ffestb_local_.decl.len = NULL;
+      ffestb_local_.decl.lent = NULL;
+      return (ffelexHandler) ffestb_decl_func_ (t);
+
+    default:
+      break;
+    }
+
+  if (ffestb_local_.decl.recursive != NULL)
+    ffelex_token_kill (ffestb_local_.decl.recursive);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_recursive2_ -- "RECURSIVE" "DOUBLE"
+
+   return ffestb_decl_recursive2_;  // to lexer
+
+   Handle NAME.	 */
+
+static ffelexHandler
+ffestb_decl_recursive2_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      switch (ffestr_second (t))
+	{
+	case FFESTR_secondPRECISION:
+	  ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
+	  break;
+
+	case FFESTR_secondCOMPLEX:
+	  ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
+	  break;
+
+	default:
+	  goto bad;		/* :::::::::::::::::::: */
+	}
+      ffestb_local_.decl.kind = NULL;
+      ffestb_local_.decl.kindt = NULL;
+      ffestb_local_.decl.len = NULL;
+      ffestb_local_.decl.lent = NULL;
+      return (ffelexHandler) ffestb_decl_func_;
+
+    default:
+      break;
+    }
+
+bad:				/* :::::::::::::::::::: */
+  if (ffestb_local_.decl.recursive != NULL)
+    ffelex_token_kill (ffestb_local_.decl.recursive);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_recursive3_ -- "RECURSIVE" "TYPE"
+
+   return ffestb_decl_recursive3_;  // to lexer
+
+   Handle OPEN_PAREN.  */
+
+static ffelexHandler
+ffestb_decl_recursive3_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeOPEN_PAREN:
+      ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_func_;
+      ffestb_local_.decl.badname = "TYPEFUNC";
+      return (ffelexHandler) ffestb_decl_typetype1_;
+
+    default:
+      break;
+    }
+
+  if (ffestb_local_.decl.recursive != NULL)
+    ffelex_token_kill (ffestb_local_.decl.recursive);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_recursive4_ -- "RECURSIVE" "FUNCTION/SUBROUTINE"
+
+   return ffestb_decl_recursive4_;  // to lexer
+
+   Handle OPEN_PAREN.  */
+
+static ffelexHandler
+ffestb_decl_recursive4_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      ffesta_tokens[1] = ffelex_token_use (t);
+      return (ffelexHandler) ffestb_dummy1_;
+
+    default:
+      break;
+    }
+
+  if (ffestb_local_.decl.recursive != NULL)
+    ffelex_token_kill (ffestb_local_.decl.recursive);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_decl_typetype -- Parse the R426/R501/R1219 TYPE statement
+
+   return ffestb_decl_typetype;	 // to lexer
+
+   Make sure the statement has a valid form for the TYPE statement.  If it
+   does, implement the statement.  */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_decl_typetype (ffelexToken t)
+{
+  switch (ffelex_token_type (ffesta_tokens[0]))
+    {
+    case FFELEX_typeNAME:
+      if (ffesta_first_kw != FFESTR_firstTYPE)
+	goto bad_0;		/* :::::::::::::::::::: */
+      break;
+
+    case FFELEX_typeNAMES:
+      if (ffesta_first_kw != FFESTR_firstTYPE)
+	goto bad_0;		/* :::::::::::::::::::: */
+      if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlTYPE)
+	goto bad_0;		/* :::::::::::::::::::: */
+      break;
+
+    default:
+      goto bad_0;		/* :::::::::::::::::::: */
+    }
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeOPEN_PAREN:
+      break;
+
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+    case FFELEX_typeCOLONCOLON:/* Not COMMA: R424 "TYPE,PUBLIC::A". */
+      ffesta_confirmed ();	/* Error, but clearly intended. */
+      goto bad_1;		/* :::::::::::::::::::: */
+
+    default:
+      goto bad_1;		/* :::::::::::::::::::: */
+    }
+
+  ffestb_local_.decl.recursive = NULL;
+  ffestb_local_.decl.parameter = FALSE;	/* No PARAMETER attribute seen. */
+  ffestb_local_.decl.coloncolon = FALSE;	/* No COLONCOLON seen. */
+
+  ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
+  ffestb_local_.decl.badname = "type-declaration";
+  return (ffelexHandler) ffestb_decl_typetype1_;
+
+bad_0:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t,
+						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
+}
+
+#endif
+/* ffestb_decl_attrs_ -- "type" [type parameters] COMMA
+
+   return ffestb_decl_attrs_;  // to lexer
+
+   Handle NAME of an attribute.	 */
+
+static ffelexHandler
+ffestb_decl_attrs_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      switch (ffestr_first (t))
+	{
+#if FFESTR_F90
+	case FFESTR_firstALLOCATABLE:
+	  if (!ffesta_is_inhibited ())
+	    ffestc_decl_attrib (FFESTP_attribALLOCATABLE, t,
+				FFESTR_otherNone, NULL);
+	  return (ffelexHandler) ffestb_decl_attrs_7_;
+#endif
+
+	case FFESTR_firstDIMENSION:
+	  ffesta_tokens[1] = ffelex_token_use (t);
+	  return (ffelexHandler) ffestb_decl_attrs_1_;
+
+	case FFESTR_firstEXTERNAL:
+	  if (!ffesta_is_inhibited ())
+	    ffestc_decl_attrib (FFESTP_attribEXTERNAL, t,
+				FFESTR_otherNone, NULL);
+	  return (ffelexHandler) ffestb_decl_attrs_7_;
+
+#if FFESTR_F90
+	case FFESTR_firstINTENT:
+	  ffesta_tokens[1] = ffelex_token_use (t);
+	  return (ffelexHandler) ffestb_decl_attrs_3_;
+#endif
+
+	case FFESTR_firstINTRINSIC:
+	  if (!ffesta_is_inhibited ())
+	    ffestc_decl_attrib (FFESTP_attribINTRINSIC, t,
+				FFESTR_otherNone, NULL);
+	  return (ffelexHandler) ffestb_decl_attrs_7_;
+
+#if FFESTR_F90
+	case FFESTR_firstOPTIONAL:
+	  if (!ffesta_is_inhibited ())
+	    ffestc_decl_attrib (FFESTP_attribOPTIONAL, t,
+				FFESTR_otherNone, NULL);
+	  return (ffelexHandler) ffestb_decl_attrs_7_;
+#endif
+
+	case FFESTR_firstPARAMETER:
+	  ffestb_local_.decl.parameter = TRUE;
+	  if (!ffesta_is_inhibited ())
+	    ffestc_decl_attrib (FFESTP_attribPARAMETER, t,
+				FFESTR_otherNone, NULL);
+	  return (ffelexHandler) ffestb_decl_attrs_7_;
+
+#if FFESTR_F90
+	case FFESTR_firstPOINTER:
+	  if (!ffesta_is_inhibited ())
+	    ffestc_decl_attrib (FFESTP_attribPOINTER, t,
+				FFESTR_otherNone, NULL);
+	  return (ffelexHandler) ffestb_decl_attrs_7_;
+#endif
+
+#if FFESTR_F90
+	case FFESTR_firstPRIVATE:
+	  if (!ffesta_is_inhibited ())
+	    ffestc_decl_attrib (FFESTP_attribPRIVATE, t,
+				FFESTR_otherNone, NULL);
+	  return (ffelexHandler) ffestb_decl_attrs_7_;
+
+	case FFESTR_firstPUBLIC:
+	  if (!ffesta_is_inhibited ())
+	    ffestc_decl_attrib (FFESTP_attribPUBLIC, t,
+				FFESTR_otherNone, NULL);
+	  return (ffelexHandler) ffestb_decl_attrs_7_;
+#endif
+
+	case FFESTR_firstSAVE:
+	  if (!ffesta_is_inhibited ())
+	    ffestc_decl_attrib (FFESTP_attribSAVE, t,
+				FFESTR_otherNone, NULL);
+	  return (ffelexHandler) ffestb_decl_attrs_7_;
+
+#if FFESTR_F90
+	case FFESTR_firstTARGET:
+	  if (!ffesta_is_inhibited ())
+	    ffestc_decl_attrib (FFESTP_attribTARGET, t,
+				FFESTR_otherNone, NULL);
+	  return (ffelexHandler) ffestb_decl_attrs_7_;
+#endif
+
+	default:
+	  ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
+	  return (ffelexHandler) ffestb_decl_attrs_7_;
+	}
+      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_3_ -- "type" [type parameters] ",INTENT"
+
+   return ffestb_decl_attrs_3_;	 // to lexer
+
+   Handle OPEN_PAREN.  */
+
+#if FFESTR_F90
+static ffelexHandler
+ffestb_decl_attrs_3_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeOPEN_PAREN:
+      return (ffelexHandler) ffestb_decl_attrs_4_;
+
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeCOLONCOLON:
+      ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, ffesta_tokens[1]);
+      ffelex_token_kill (ffesta_tokens[1]);
+      return (ffelexHandler) ffestb_decl_attrs_7_ (t);
+
+    default:
+      break;
+    }
+
+  if (!ffesta_is_inhibited ())
+    ffestc_decl_finish ();
+  ffelex_token_kill (ffesta_tokens[1]);
+  ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_attrs_4_ -- "type" [type parameters] ",INTENT" OPEN_PAREN
+
+   return ffestb_decl_attrs_4_;	 // to lexer
+
+   Handle NAME.	 */
+
+static ffelexHandler
+ffestb_decl_attrs_4_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      ffestb_local_.decl.kw = ffestr_other (t);
+      switch (ffestb_local_.decl.kw)
+	{
+	case FFESTR_otherIN:
+	  return (ffelexHandler) ffestb_decl_attrs_5_;
+
+	case FFESTR_otherINOUT:
+	  return (ffelexHandler) ffestb_decl_attrs_6_;
+
+	case FFESTR_otherOUT:
+	  return (ffelexHandler) ffestb_decl_attrs_6_;
+
+	default:
+	  ffestb_local_.decl.kw = FFESTR_otherNone;
+	  ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
+	  return (ffelexHandler) ffestb_decl_attrs_5_;
+	}
+      break;
+
+    default:
+      break;
+    }
+
+  if (!ffesta_is_inhibited ())
+    ffestc_decl_finish ();
+  ffelex_token_kill (ffesta_tokens[1]);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_attrs_5_ -- "type" [type parameters] ",INTENT" OPEN_PAREN "IN"
+
+   return ffestb_decl_attrs_5_;	 // to lexer
+
+   Handle NAME or CLOSE_PAREN.	*/
+
+static ffelexHandler
+ffestb_decl_attrs_5_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      switch (ffestr_other (t))
+	{
+	case FFESTR_otherOUT:
+	  if (ffestb_local_.decl.kw != FFESTR_otherNone)
+	    ffestb_local_.decl.kw = FFESTR_otherINOUT;
+	  return (ffelexHandler) ffestb_decl_attrs_6_;
+
+	default:
+	  if (ffestb_local_.decl.kw != FFESTR_otherNone)
+	    {
+	      ffestb_local_.decl.kw = FFESTR_otherNone;
+	      ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
+	    }
+	  return (ffelexHandler) ffestb_decl_attrs_5_;
+	}
+      break;
+
+    case FFELEX_typeCLOSE_PAREN:
+      return (ffelexHandler) ffestb_decl_attrs_6_ (t);
+
+    default:
+      break;
+    }
+
+  if (!ffesta_is_inhibited ())
+    ffestc_decl_finish ();
+  ffelex_token_kill (ffesta_tokens[1]);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_attrs_6_ -- "type" [type parameters] ",INTENT" OPEN_PAREN "IN"
+			  ["OUT"]
+
+   return ffestb_decl_attrs_6_;	 // to lexer
+
+   Handle CLOSE_PAREN.	*/
+
+static ffelexHandler
+ffestb_decl_attrs_6_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCLOSE_PAREN:
+      if ((ffestb_local_.decl.kw != FFESTR_otherNone)
+	  && !ffesta_is_inhibited ())
+	ffestc_decl_attrib (FFESTP_attribINTENT, ffesta_tokens[1],
+			    ffestb_local_.decl.kw, NULL);
+      ffelex_token_kill (ffesta_tokens[1]);
+      return (ffelexHandler) ffestb_decl_attrs_7_;
+
+    default:
+      break;
+    }
+
+  if (!ffesta_is_inhibited ())
+    ffestc_decl_finish ();
+  ffelex_token_kill (ffesta_tokens[1]);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_decl_attrs_7_ -- "type" [type parameters] attribute
+
+   return ffestb_decl_attrs_7_;	 // to lexer
+
+   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]))
+	{
+#if FFESTR_F90
+	case FFESTR_firstRECURSIVE:
+	  if (ffestr_first (t) != FFESTR_firstFUNCTION)
+	    {
+	      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+	      break;
+	    }
+	  ffestb_local_.decl.recursive = ffesta_tokens[1];
+	  return (ffelexHandler) ffestb_decl_funcname_;
+#endif
+
+	case FFESTR_firstFUNCTION:
+	  ffelex_token_kill (ffesta_tokens[1]);
+	  return (ffelexHandler) ffestb_decl_funcname_ (t);
+
+	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;
+  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]))
+	{
+#if FFESTR_F90
+	case FFESTR_firstRECURSIVEFNCTN:
+	  if (!asterisk_ok)
+	    break;		/* For our own convenience, treat as non-FN
+				   stmt. */
+	  p = ffelex_token_text (ffesta_tokens[1])
+	    + (i = FFESTR_firstlRECURSIVEFNCTN);
+	  if (!ffesrc_is_name_init (*p))
+	    break;
+	  ffestb_local_.decl.recursive
+	    = ffelex_token_name_from_names (ffesta_tokens[1], 0,
+					    FFESTR_firstlRECURSIVEFNCTN);
+	  ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
+					    FFESTR_firstlRECURSIVEFNCTN, 0);
+	  return (ffelexHandler) ffestb_decl_entsp_3_;
+#endif
+
+	case FFESTR_firstFUNCTION:
+	  if (!asterisk_ok)
+	    break;		/* For our own convenience, treat as non-FN
+				   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]))
+	{
+#if FFESTR_F90
+	case FFESTR_firstRECURSIVEFNCTN:
+	  p = ffelex_token_text (ffesta_tokens[1])
+	    + (i = FFESTR_firstlRECURSIVEFNCTN);
+	  if (!ffesrc_is_name_init (*p))
+	    break;
+	  ffestb_local_.decl.recursive
+	    = ffelex_token_name_from_names (ffesta_tokens[1], 0,
+					    FFESTR_firstlRECURSIVEFNCTN);
+	  ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
+					    FFESTR_firstlRECURSIVEFNCTN, 0);
+	  return (ffelexHandler) ffestb_decl_entsp_5_ (t);
+#endif
+
+	case FFESTR_firstFUNCTION:
+	  p = ffelex_token_text (ffesta_tokens[1])
+	    + (i = FFESTR_firstlFUNCTION);
+	  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_func_ -- ["type" [type parameters]] RECURSIVE
+
+   return ffestb_decl_func_;  // to lexer
+
+   Handle "FUNCTION".  */
+
+#if FFESTR_F90
+static ffelexHandler
+ffestb_decl_func_ (ffelexToken t)
+{
+  char *p;
+  ffeTokenLength i;
+
+  ffelex_set_names (FALSE);
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      if (ffestr_first (t) != FFESTR_firstFUNCTION)
+	break;
+      return (ffelexHandler) ffestb_decl_funcname_;
+
+    case FFELEX_typeNAMES:
+      ffesta_confirmed ();
+      if (ffestr_first (t) != FFESTR_firstFUNCTION)
+	break;
+      p = ffelex_token_text (t) + (i = FFESTR_firstlFUNCTION);
+      if (*p == '\0')
+	break;
+      if (!ffesrc_is_name_init (*p))
+	goto bad_i;		/* :::::::::::::::::::: */
+      ffesta_tokens[1] = ffelex_token_name_from_names (t, i, 0);
+      return (ffelexHandler) ffestb_decl_funcname_1_;
+
+    default:
+      break;
+    }
+
+  if (ffestb_local_.decl.recursive != NULL)
+    ffelex_token_kill (ffestb_local_.decl.recursive);
+  if (ffestb_local_.decl.kindt != NULL)
+    ffelex_token_kill (ffestb_local_.decl.kindt);
+  if (ffestb_local_.decl.lent != NULL)
+    ffelex_token_kill (ffestb_local_.decl.lent);
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_i:				/* :::::::::::::::::::: */
+  if (ffestb_local_.decl.recursive != NULL)
+    ffelex_token_kill (ffestb_local_.decl.recursive);
+  if (ffestb_local_.decl.kindt != NULL)
+    ffelex_token_kill (ffestb_local_.decl.kindt);
+  if (ffestb_local_.decl.lent != NULL)
+    ffelex_token_kill (ffestb_local_.decl.lent);
+  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t, i, NULL);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_decl_funcname_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+
+   return ffestb_decl_funcname_;  // to lexer
+
+   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_V003 -- Parse the STRUCTURE statement
+
+   return ffestb_V003;	// to lexer
+
+   Make sure the statement has a valid form for the STRUCTURE statement.
+   If it does, implement the statement.	 */
+
+#if FFESTR_VXT
+ffelexHandler
+ffestb_V003 (ffelexToken t)
+{
+  ffeTokenLength i;
+  char *p;
+  ffelexToken nt;
+  ffelexHandler next;
+
+  switch (ffelex_token_type (ffesta_tokens[0]))
+    {
+    case FFELEX_typeNAME:
+      if (ffesta_first_kw != FFESTR_firstSTRUCTURE)
+	goto bad_0;		/* :::::::::::::::::::: */
+      switch (ffelex_token_type (t))
+	{
+	case FFELEX_typeCOMMA:
+	case FFELEX_typeCOLONCOLON:
+	case FFELEX_typeEOS:
+	case FFELEX_typeSEMICOLON:
+	  ffesta_confirmed ();	/* Error, but clearly intended. */
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	default:
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	case FFELEX_typeNAME:
+	  ffesta_confirmed ();
+	  if (!ffesta_is_inhibited ())
+	    ffestc_V003_start (NULL);
+	  ffestb_local_.structure.started = TRUE;
+	  return (ffelexHandler) ffestb_V0034_ (t);
+
+	case FFELEX_typeSLASH:
+	  ffesta_confirmed ();
+	  return (ffelexHandler) ffestb_V0031_;
+	}
+
+    case FFELEX_typeNAMES:
+      if (ffesta_first_kw != FFESTR_firstSTRUCTURE)
+	goto bad_0;		/* :::::::::::::::::::: */
+      p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSTRUCTURE);
+      switch (ffelex_token_type (t))
+	{
+	default:
+	  goto bad_1;		/* :::::::::::::::::::: */
+
+	case FFELEX_typeEOS:
+	case FFELEX_typeSEMICOLON:
+	case FFELEX_typeCOMMA:
+	case FFELEX_typeCOLONCOLON:
+	  ffesta_confirmed ();
+	  break;
+
+	case FFELEX_typeSLASH:
+	  ffesta_confirmed ();
+	  if (*p != '\0')
+	    goto bad_1;		/* :::::::::::::::::::: */
+	  return (ffelexHandler) ffestb_V0031_;
+
+	case FFELEX_typeOPEN_PAREN:
+	  break;
+	}
+
+      /* Here, we have at least one char after "STRUCTURE" and t is COMMA,
+	 EOS/SEMICOLON, or OPEN_PAREN. */
+
+      if (!ffesrc_is_name_init (*p))
+	goto bad_i;		/* :::::::::::::::::::: */
+      nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+      if (ffelex_token_type (t) == FFELEX_typeOPEN_PAREN)
+	ffestb_local_.structure.started = FALSE;
+      else
+	{
+	  if (!ffesta_is_inhibited ())
+	    ffestc_V003_start (NULL);
+	  ffestb_local_.structure.started = TRUE;
+	}
+      next = (ffelexHandler) ffestb_V0034_ (nt);
+      ffelex_token_kill (nt);
+      return (ffelexHandler) (*next) (t);
+
+    default:
+      goto bad_0;		/* :::::::::::::::::::: */
+    }
+
+bad_0:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", ffesta_tokens[0]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t,
+						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
+
+bad_i:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", ffesta_tokens[0], i, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0031_ -- "STRUCTURE" SLASH
+
+   return ffestb_V0031_;  // to lexer
+
+   Handle NAME.	 */
+
+static ffelexHandler
+ffestb_V0031_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      ffesta_tokens[1] = ffelex_token_use (t);
+      return (ffelexHandler) ffestb_V0032_;
+
+    default:
+      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
+      break;
+    }
+
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0032_ -- "STRUCTURE" SLASH NAME
+
+   return ffestb_V0032_;  // to lexer
+
+   Handle SLASH.  */
+
+static ffelexHandler
+ffestb_V0032_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeSLASH:
+      if (!ffesta_is_inhibited ())
+	ffestc_V003_start (ffesta_tokens[1]);
+      ffestb_local_.structure.started = TRUE;
+      ffelex_token_kill (ffesta_tokens[1]);
+      return (ffelexHandler) ffestb_V0033_;
+
+    default:
+      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
+      break;
+    }
+
+  ffelex_token_kill (ffesta_tokens[1]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0033_ -- "STRUCTURE" SLASH NAME SLASH
+
+   return ffestb_V0033_;  // to lexer
+
+   Handle NAME or EOS/SEMICOLON.  */
+
+static ffelexHandler
+ffestb_V0033_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      return (ffelexHandler) ffestb_V0034_ (t);
+
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      if (!ffesta_is_inhibited ())
+	ffestc_V003_finish ();
+      return (ffelexHandler) ffesta_zero (t);
+
+    default:
+      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
+      break;
+    }
+
+  ffelex_token_kill (ffesta_tokens[1]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0034_ -- "STRUCTURE" [SLASH NAME SLASH]
+
+   return ffestb_V0034_;  // to lexer
+
+   Handle NAME.	 */
+
+static ffelexHandler
+ffestb_V0034_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      ffesta_tokens[1] = ffelex_token_use (t);
+      return (ffelexHandler) ffestb_V0035_;
+
+    default:
+      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
+      break;
+    }
+
+  if (!ffesta_is_inhibited ())
+    ffestc_V003_finish ();
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0035_ -- "STRUCTURE" ... NAME
+
+   return ffestb_V0035_;  // to lexer
+
+   Handle OPEN_PAREN.  */
+
+static ffelexHandler
+ffestb_V0035_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeOPEN_PAREN:
+      ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
+      ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_V0036_;
+      ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
+      ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLISTCOMMON;
+#ifdef FFECOM_dimensionsMAX
+      ffestb_subrargs_.dim_list.ndims = 0;
+#endif
+      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+      FFEEXPR_contextDIMLISTCOMMON, (ffeexprCallback) ffestb_subr_dimlist_);
+
+    case FFELEX_typeCOMMA:
+      if (!ffesta_is_inhibited ())
+	ffestc_V003_item (ffesta_tokens[1], NULL);
+      ffelex_token_kill (ffesta_tokens[1]);
+      return (ffelexHandler) ffestb_V0034_;
+
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      if (!ffesta_is_inhibited ())
+	{
+	  ffestc_V003_item (ffesta_tokens[1], NULL);
+	  ffestc_V003_finish ();
+	}
+      ffelex_token_kill (ffesta_tokens[1]);
+      return (ffelexHandler) ffesta_zero (t);
+
+    default:
+      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
+      break;
+    }
+
+  if (!ffesta_is_inhibited ())
+    ffestc_V003_finish ();
+  ffelex_token_kill (ffesta_tokens[1]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0036_ -- "STRUCTURE" ... NAME OPEN_PAREN dimlist CLOSE_PAREN
+
+   return ffestb_V0036_;  // to lexer
+
+   Handle COMMA or EOS/SEMICOLON.  */
+
+static ffelexHandler
+ffestb_V0036_ (ffelexToken t)
+{
+  if (!ffestb_subrargs_.dim_list.ok)
+    goto bad;			/* :::::::::::::::::::: */
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+      ffesta_confirmed ();
+      if (!ffesta_is_inhibited ())
+	{
+	  if (!ffestb_local_.structure.started)
+	    {
+	      ffestc_V003_start (NULL);
+	      ffestb_local_.structure.started = TRUE;
+	    }
+	  ffestc_V003_item (ffesta_tokens[1],
+			    ffestb_subrargs_.dim_list.dims);
+	}
+      ffelex_token_kill (ffesta_tokens[1]);
+      ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+      return (ffelexHandler) ffestb_V0034_;
+
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      ffesta_confirmed ();
+      if (!ffesta_is_inhibited ())
+	{
+	  if (!ffestb_local_.structure.started)
+	    ffestc_V003_start (NULL);
+	  ffestc_V003_item (ffesta_tokens[1],
+			    ffestb_subrargs_.dim_list.dims);
+	  ffestc_V003_finish ();
+	}
+      ffelex_token_kill (ffesta_tokens[1]);
+      ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+      return (ffelexHandler) ffesta_zero (t);
+
+    default:
+      break;
+    }
+
+bad:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
+  if (ffestb_local_.structure.started && !ffesta_is_inhibited ())
+    ffestc_V003_finish ();
+  ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+  ffelex_token_kill (ffesta_tokens[1]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V016 -- Parse the RECORD statement
+
+   return ffestb_V016;	// to lexer
+
+   Make sure the statement has a valid form for the RECORD statement.  If it
+   does, implement the statement.  */
+
+ffelexHandler
+ffestb_V016 (ffelexToken t)
+{
+  char *p;
+  ffeTokenLength i;
+
+  switch (ffelex_token_type (ffesta_tokens[0]))
+    {
+    case FFELEX_typeNAME:
+      if (ffesta_first_kw != FFESTR_firstRECORD)
+	goto bad_0;		/* :::::::::::::::::::: */
+      break;
+
+    case FFELEX_typeNAMES:
+      if (ffesta_first_kw != FFESTR_firstRECORD)
+	goto bad_0;		/* :::::::::::::::::::: */
+      p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlRECORD);
+      if (*p != '\0')
+	goto bad_i;		/* :::::::::::::::::::: */
+      break;
+
+    default:
+      goto bad_0;		/* :::::::::::::::::::: */
+    }
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+    case FFELEX_typeCOLONCOLON:
+      ffesta_confirmed ();	/* Error, but clearly intended. */
+      goto bad_1;		/* :::::::::::::::::::: */
+
+    default:
+      goto bad_1;		/* :::::::::::::::::::: */
+
+    case FFELEX_typeSLASH:
+      break;
+    }
+
+  ffesta_confirmed ();
+  if (!ffesta_is_inhibited ())
+    ffestc_V016_start ();
+  return (ffelexHandler) ffestb_V0161_;
+
+bad_0:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", ffesta_tokens[0]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t,
+						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
+
+bad_i:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "RECORD", ffesta_tokens[0], i, t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0161_ -- "RECORD" SLASH
+
+   return ffestb_V0161_;  // to lexer
+
+   Handle NAME.	 */
+
+static ffelexHandler
+ffestb_V0161_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      if (!ffesta_is_inhibited ())
+	ffestc_V016_item_structure (t);
+      return (ffelexHandler) ffestb_V0162_;
+
+    default:
+      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
+      break;
+    }
+
+  if (!ffesta_is_inhibited ())
+    ffestc_V016_finish ();
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0162_ -- "RECORD" SLASH NAME
+
+   return ffestb_V0162_;  // to lexer
+
+   Handle SLASH.  */
+
+static ffelexHandler
+ffestb_V0162_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeSLASH:
+      return (ffelexHandler) ffestb_V0163_;
+
+    default:
+      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
+      break;
+    }
+
+  if (!ffesta_is_inhibited ())
+    ffestc_V016_finish ();
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0163_ -- "RECORD" SLASH NAME SLASH
+
+   return ffestb_V0163_;  // to lexer
+
+   Handle NAME.	 */
+
+static ffelexHandler
+ffestb_V0163_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      ffesta_tokens[1] = ffelex_token_use (t);
+      return (ffelexHandler) ffestb_V0164_;
+
+    default:
+      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
+      break;
+    }
+
+  if (!ffesta_is_inhibited ())
+    ffestc_V016_finish ();
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0164_ -- "RECORD" ... NAME
+
+   return ffestb_V0164_;  // to lexer
+
+   Handle OPEN_PAREN.  */
+
+static ffelexHandler
+ffestb_V0164_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeOPEN_PAREN:
+      ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
+      ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_V0165_;
+      ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
+      ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLISTCOMMON;
+#ifdef FFECOM_dimensionsMAX
+      ffestb_subrargs_.dim_list.ndims = 0;
+#endif
+      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+      FFEEXPR_contextDIMLISTCOMMON, (ffeexprCallback) ffestb_subr_dimlist_);
+
+    case FFELEX_typeCOMMA:
+      if (!ffesta_is_inhibited ())
+	ffestc_V016_item_object (ffesta_tokens[1], NULL);
+      ffelex_token_kill (ffesta_tokens[1]);
+      return (ffelexHandler) ffestb_V0166_;
+
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      if (!ffesta_is_inhibited ())
+	{
+	  ffestc_V016_item_object (ffesta_tokens[1], NULL);
+	  ffestc_V016_finish ();
+	}
+      ffelex_token_kill (ffesta_tokens[1]);
+      return (ffelexHandler) ffesta_zero (t);
+
+    default:
+      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
+      break;
+    }
+
+  if (!ffesta_is_inhibited ())
+    ffestc_V016_finish ();
+  ffelex_token_kill (ffesta_tokens[1]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0165_ -- "RECORD" ... NAME OPEN_PAREN dimlist CLOSE_PAREN
+
+   return ffestb_V0165_;  // to lexer
+
+   Handle COMMA or EOS/SEMICOLON.  */
+
+static ffelexHandler
+ffestb_V0165_ (ffelexToken t)
+{
+  if (!ffestb_subrargs_.dim_list.ok)
+    goto bad;			/* :::::::::::::::::::: */
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+      if (!ffesta_is_inhibited ())
+	ffestc_V016_item_object (ffesta_tokens[1],
+				 ffestb_subrargs_.dim_list.dims);
+      ffelex_token_kill (ffesta_tokens[1]);
+      ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+      return (ffelexHandler) ffestb_V0166_;
+
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      if (!ffesta_is_inhibited ())
+	{
+	  ffestc_V016_item_object (ffesta_tokens[1],
+				   ffestb_subrargs_.dim_list.dims);
+	  ffestc_V016_finish ();
+	}
+      ffelex_token_kill (ffesta_tokens[1]);
+      ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+      return (ffelexHandler) ffesta_zero (t);
+
+    default:
+      break;
+    }
+
+bad:				/* :::::::::::::::::::: */
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
+  if (ffestb_local_.structure.started && !ffesta_is_inhibited ())
+    ffestc_V016_finish ();
+  ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+  ffelex_token_kill (ffesta_tokens[1]);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0166_ -- "RECORD" SLASH NAME SLASH NAME [OPEN_PAREN dimlist
+		    CLOSE_PAREN] COMMA
+
+   return ffestb_V0166_;  // to lexer
+
+   Handle NAME or SLASH.  */
+
+static ffelexHandler
+ffestb_V0166_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      ffesta_tokens[1] = ffelex_token_use (t);
+      return (ffelexHandler) ffestb_V0164_;
+
+    case FFELEX_typeSLASH:
+      return (ffelexHandler) ffestb_V0161_;
+
+    default:
+      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
+      break;
+    }
+
+  if (!ffesta_is_inhibited ())
+    ffestc_V016_finish ();
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_V027 -- Parse the VXT PARAMETER statement
+
+   return ffestb_V027;	// to lexer
+
+   Make sure the statement has a valid form for the VXT PARAMETER statement.
+   If it does, implement the statement.	 */
+
+ffelexHandler
+ffestb_V027 (ffelexToken t)
+{
+  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;
+  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_;
+
+#if FFESTR_F90
+	case FFESTR_secondTYPE:
+	  ffestb_local_.decl.type = FFESTP_typeTYPE;
+	  return (ffelexHandler) ffestb_decl_R5393_;
+#endif
+
+	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);
+
+#if FFESTR_F90
+	case FFESTR_secondTYPE:
+	  ffestb_local_.decl.type = FFESTP_typeTYPE;
+	  return (ffelexHandler) ffestb_decl_R5393_ (t);
+#endif
+
+	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_R5393_ -- "IMPLICIT" "TYPE"
+
+   return ffestb_decl_R5393_;  // to lexer
+
+   Handle OPEN_PAREN.  */
+
+#if FFESTR_F90
+static ffelexHandler
+ffestb_decl_R5393_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeOPEN_PAREN:
+      ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_R539letters_;
+      ffestb_local_.decl.badname = "IMPLICIT";
+      return (ffelexHandler) ffestb_decl_typetype1_;
+
+    default:
+      break;
+    }
+
+  if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
+    ffestc_R539finish ();
+  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
+  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_decl_R5394_ -- "IMPLICIT" "NONE"
+
+   return ffestb_decl_R5394_;  // to lexer
+
+   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_;
+
+#if FFESTR_F90
+	case FFESTR_secondTYPE:
+	  ffestb_local_.decl.type = FFESTP_typeTYPE;
+	  return (ffelexHandler) ffestb_decl_R5393_;
+#endif
+
+	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
new file mode 100644
index 00000000000..a3385d9a596
--- /dev/null
+++ b/gcc/f/stb.h
@@ -0,0 +1,253 @@
+/* stb.h -- Private #include File (module.h template V1.0)
+   Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_stb
+#define _H_f_stb
+
+/* 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
+      {
+	char *badname;
+	ffeTokenLength len;	/* Length of "ENTRY/FUNCTION/SUBROUTINE". */
+	bool is_subr;		/* TRUE if SUBROUTINE or if ENTRY within
+				   SUBROUTINE. */
+      }
+    dummy;
+    struct
+      {
+	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;
+#if FFESTR_F90
+    struct
+      {
+	char *badname;
+	ffeTokenLength len;	/* Length of "ALLOCATE/DEALLOCATE". */
+	ffeexprContext ctx;	/* Either ALLOCATE or DEALLOCATE. */
+      }
+    heap;
+#endif
+    struct
+      {
+	char *badname;
+	ffeTokenLength len;	/* Length of
+				   "EXTERNAL/INTENT/INTRINSIC/OPTIONAL/PUBLIC/
+				   PRIVATE". */
+      }
+    varlist;
+#if FFESTR_VXT
+    struct
+      {
+	char *badname;
+	ffeTokenLength len;	/* Length of "ENCODE/DECODE". */
+      }
+    vxtcode;
+#endif
+#if FFESTR_F90
+    struct
+      {
+	char *badname;
+	ffeTokenLength len;	/* Length of "ALLOCATABLE/POINTER/TARGET". */
+      }
+    dimlist;
+#endif
+    struct
+      {
+	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);
+#if FFESTR_F90
+ffelexHandler ffestb_heap (ffelexToken t);
+#endif
+ffelexHandler ffestb_if (ffelexToken t);
+ffelexHandler ffestb_let (ffelexToken t);
+#if FFESTR_F90
+ffelexHandler ffestb_module (ffelexToken t);
+#endif
+#if FFESTR_F90
+ffelexHandler ffestb_decl_recursive (ffelexToken t);
+#endif
+#if FFESTR_F90
+ffelexHandler ffestb_type (ffelexToken t);
+#endif
+#if FFESTR_F90
+ffelexHandler ffestb_decl_typetype (ffelexToken t);
+#endif
+ffelexHandler ffestb_varlist (ffelexToken t);
+#if FFESTR_VXT
+ffelexHandler ffestb_vxtcode (ffelexToken t);
+#endif
+#if FFESTR_F90
+ffelexHandler ffestb_where (ffelexToken t);
+#endif
+#if HARD_F90
+ffelexHandler ffestb_R423B (ffelexToken t);
+#endif
+ffelexHandler ffestb_R522 (ffelexToken t);
+ffelexHandler ffestb_R524 (ffelexToken t);
+ffelexHandler ffestb_R528 (ffelexToken t);
+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);
+#if FFESTR_F90
+ffelexHandler ffestb_R624 (ffelexToken t);
+#endif
+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);
+#if FFESTR_F90
+ffelexHandler ffestb_R1107 (ffelexToken t);
+#endif
+#if FFESTR_F90
+ffelexHandler ffestb_R1202 (ffelexToken t);
+#endif
+ffelexHandler ffestb_R1212 (ffelexToken t);
+ffelexHandler ffestb_R1227 (ffelexToken t);
+#if FFESTR_F90
+ffelexHandler ffestb_R1228 (ffelexToken t);
+#endif
+ffelexHandler ffestb_R1229 (ffelexToken t);
+ffelexHandler ffestb_S3P4 (ffelexToken t);
+#if FFESTR_VXT
+ffelexHandler ffestb_V003 (ffelexToken t);
+ffelexHandler ffestb_V009 (ffelexToken t);
+ffelexHandler ffestb_V012 (ffelexToken t);
+#endif
+ffelexHandler ffestb_V014 (ffelexToken t);
+#if FFESTR_VXT
+ffelexHandler ffestb_V016 (ffelexToken t);
+ffelexHandler ffestb_V018 (ffelexToken t);
+ffelexHandler ffestb_V019 (ffelexToken t);
+#endif
+ffelexHandler ffestb_V020 (ffelexToken t);
+#if FFESTR_VXT
+ffelexHandler ffestb_V021 (ffelexToken t);
+ffelexHandler ffestb_V025 (ffelexToken t);
+ffelexHandler ffestb_V026 (ffelexToken t);
+#endif
+ffelexHandler ffestb_V027 (ffelexToken t);
+
+/* Define macros. */
+
+#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
diff --git a/gcc/f/stc.c b/gcc/f/stc.c
new file mode 100644
index 00000000000..ef91d7188dd
--- /dev/null
+++ b/gcc/f/stc.c
@@ -0,0 +1,13895 @@
+/* stc.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995-1997 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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;
+#if FFESTR_VXT
+    struct
+      {
+	char list_state;	/* 0=>no field names allowed, 1=>error
+				   reported already, 2=>field names req'd,
+				   3=>have a field name. */
+      }
+    V003;
+#endif
+  };				/* Merge with the one in ffestc later. */
+
+/* Static objects accessed by functions in this module. */
+
+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);
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_access_ (void);
+#endif
+static ffestcOrder_ ffestc_order_actiondo_ (void);
+static ffestcOrder_ ffestc_order_actionif_ (void);
+static ffestcOrder_ ffestc_order_actionwhere_ (void);
+static void ffestc_order_any_ (void);
+static void ffestc_order_bad_ (void);
+static ffestcOrder_ ffestc_order_blockdata_ (void);
+static ffestcOrder_ ffestc_order_blockspec_ (void);
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_component_ (void);
+#endif
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_contains_ (void);
+#endif
+static ffestcOrder_ ffestc_order_data_ (void);
+static ffestcOrder_ ffestc_order_data77_ (void);
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_derivedtype_ (void);
+#endif
+static ffestcOrder_ ffestc_order_do_ (void);
+static ffestcOrder_ ffestc_order_entry_ (void);
+static ffestcOrder_ ffestc_order_exec_ (void);
+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);
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_interface_ (void);
+#endif
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_map_ (void);
+#endif
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_module_ (void);
+#endif
+static ffestcOrder_ ffestc_order_parameter_ (void);
+static ffestcOrder_ ffestc_order_program_ (void);
+static ffestcOrder_ ffestc_order_progspec_ (void);
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_record_ (void);
+#endif
+static ffestcOrder_ ffestc_order_selectcase_ (void);
+static ffestcOrder_ ffestc_order_sfunc_ (void);
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_spec_ (void);
+#endif
+#if FFESTR_VXT
+static ffestcOrder_ ffestc_order_structure_ (void);
+#endif
+static ffestcOrder_ ffestc_order_subroutine_ (void);
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_type_ (void);
+#endif
+static ffestcOrder_ ffestc_order_typedecl_ (void);
+#if FFESTR_VXT
+static ffestcOrder_ ffestc_order_union_ (void);
+#endif
+static ffestcOrder_ ffestc_order_unit_ (void);
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_use_ (void);
+#endif
+#if FFESTR_VXT
+static ffestcOrder_ ffestc_order_vxtstructure_ (void);
+#endif
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_where_ (void);
+#endif
+static void ffestc_promote_dummy_ (ffelexToken t);
+static void ffestc_promote_execdummy_ (ffelexToken t);
+static void ffestc_promote_sfdummy_ (ffelexToken t);
+static void ffestc_shriek_begin_program_ (void);
+#if FFESTR_F90
+static void ffestc_shriek_begin_uses_ (void);
+#endif
+static void ffestc_shriek_blockdata_ (bool ok);
+static void ffestc_shriek_do_ (bool ok);
+static void ffestc_shriek_end_program_ (bool ok);
+#if FFESTR_F90
+static void ffestc_shriek_end_uses_ (bool ok);
+#endif
+static void ffestc_shriek_function_ (bool ok);
+static void ffestc_shriek_if_ (bool ok);
+static void ffestc_shriek_ifthen_ (bool ok);
+#if FFESTR_F90
+static void ffestc_shriek_interface_ (bool ok);
+#endif
+#if FFESTR_F90
+static void ffestc_shriek_map_ (bool ok);
+#endif
+#if FFESTR_F90
+static void ffestc_shriek_module_ (bool ok);
+#endif
+static void ffestc_shriek_select_ (bool ok);
+#if FFESTR_VXT
+static void ffestc_shriek_structure_ (bool ok);
+#endif
+static void ffestc_shriek_subroutine_ (bool ok);
+#if FFESTR_F90
+static void ffestc_shriek_type_ (bool ok);
+#endif
+#if FFESTR_VXT
+static void ffestc_shriek_union_ (bool ok);
+#endif
+#if FFESTR_F90
+static void ffestc_shriek_where_ (bool ok);
+#endif
+#if FFESTR_F90
+static void ffestc_shriek_wherethen_ (bool ok);
+#endif
+static int ffestc_subr_binsrch_ (char **list, int size, ffestpFile *spec,
+				 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_ (char *name, ffestpFile *spec);
+static int ffestc_subr_speccmp_ (char *string, ffestpFile *spec,
+				 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_()
+#if FFESTR_F90
+#define ffestc_order_interfacespec_() ffestc_order_derivedtype_()
+#endif
+#define ffestc_shriek_if_lost_ ffestc_shriek_if_
+#if FFESTR_F90
+#define ffestc_shriek_where_lost_ ffestc_shriek_where_
+#endif
+
+/* ffestc_establish_declinfo_ -- Determine specific type/params info for entity
+
+   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 ()
+{
+  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 ()
+{
+  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_ ()
+{
+  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_ ()
+{
+  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_ ()
+{
+  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_ ()
+{
+  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_ ()
+{
+  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_ ()
+{
+  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_ ()
+{
+  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_ ()
+{
+  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_ ()
+{
+  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_ ()
+{
+  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_access_ -- Check ordering on <access> statement
+
+   if (ffestc_order_access_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_access_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateMODULE0:
+    case FFESTV_stateMODULE1:
+    case FFESTV_stateMODULE2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateMODULE3:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* ffestc_order_actiondo_ -- Check ordering on <actiondo> statement
+
+   if (ffestc_order_actiondo_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_actiondo_ ()
+{
+  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:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    default:
+      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_ ()
+{
+  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:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    default:
+      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_ ()
+{
+  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:
+#if FFESTR_F90
+      ffestc_shriek_after1_ = ffestc_shriek_where_;
+#endif
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateIF:
+      ffestc_shriek_after1_ = ffestc_shriek_if_;
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      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_ ()
+{
+  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:
+#if FFESTR_F90
+      ffestc_shriek_after1_ = ffestc_shriek_where_;
+#endif
+      return;
+
+    case FFESTV_stateIF:
+      ffestc_shriek_after1_ = ffestc_shriek_if_;
+      return;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      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_ ()
+{
+  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_ ()
+{
+  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:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_blockspec_ -- Check ordering on <blockspec> statement
+
+   if (ffestc_order_blockspec_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_blockspec_ ()
+{
+  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:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_component_ -- Check ordering on <component-decl> statement
+
+   if (ffestc_order_component_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_component_ ()
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateTYPE:
+    case FFESTV_stateSTRUCTURE:
+    case FFESTV_stateMAP:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+      ffestc_shriek_where_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* ffestc_order_contains_ -- Check ordering on CONTAINS statement
+
+   if (ffestc_order_contains_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_contains_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_statePROGRAM0:
+    case FFESTV_statePROGRAM1:
+    case FFESTV_statePROGRAM2:
+    case FFESTV_statePROGRAM3:
+    case FFESTV_statePROGRAM4:
+      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM5);
+      break;
+
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateSUBROUTINE1:
+    case FFESTV_stateSUBROUTINE2:
+    case FFESTV_stateSUBROUTINE3:
+    case FFESTV_stateSUBROUTINE4:
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE5);
+      break;
+
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateFUNCTION1:
+    case FFESTV_stateFUNCTION2:
+    case FFESTV_stateFUNCTION3:
+    case FFESTV_stateFUNCTION4:
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION5);
+      break;
+
+    case FFESTV_stateMODULE0:
+    case FFESTV_stateMODULE1:
+    case FFESTV_stateMODULE2:
+    case FFESTV_stateMODULE3:
+    case FFESTV_stateMODULE4:
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE5);
+      break;
+
+    case FFESTV_stateUSE:
+      ffestc_shriek_end_uses_ (TRUE);
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+      ffestc_shriek_where_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      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:
+      ffestw_update (NULL);
+      return FFESTC_orderOK_;
+
+    default:
+      ffestc_order_bad_ ();
+      ffestw_update (NULL);
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* ffestc_order_data_ -- Check ordering on DATA statement
+
+   if (ffestc_order_data_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_data_ ()
+{
+  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:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_data77_ -- Check ordering on pedantic-F77 DATA statement
+
+   if (ffestc_order_data77_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_data77_ ()
+{
+  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:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_derivedtype_ -- Check ordering on derived TYPE statement
+
+   if (ffestc_order_derivedtype_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_derivedtype_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_statePROGRAM0:
+    case FFESTV_statePROGRAM1:
+    case FFESTV_statePROGRAM2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateSUBROUTINE1:
+    case FFESTV_stateSUBROUTINE2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateFUNCTION1:
+    case FFESTV_stateFUNCTION2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateMODULE0:
+    case FFESTV_stateMODULE1:
+    case FFESTV_stateMODULE2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_statePROGRAM3:
+    case FFESTV_stateSUBROUTINE3:
+    case FFESTV_stateFUNCTION3:
+    case FFESTV_stateMODULE3:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+      ffestc_shriek_end_uses_ (TRUE);
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+      ffestc_shriek_where_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* ffestc_order_do_ -- Check ordering on <do> statement
+
+   if (ffestc_order_do_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_do_ ()
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateDO:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_entry_ -- Check ordering on ENTRY statement
+
+   if (ffestc_order_entry_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_entry_ ()
+{
+  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:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+
+  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_ ()
+{
+  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:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+
+  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_ ()
+{
+  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:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_function_ -- Check ordering on <function> statement
+
+   if (ffestc_order_function_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_function_ ()
+{
+  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:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_iface_ -- Check ordering on <iface> statement
+
+   if (ffestc_order_iface_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_iface_ ()
+{
+  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_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_ifthen_ -- Check ordering on <ifthen> statement
+
+   if (ffestc_order_ifthen_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_ifthen_ ()
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateIFTHEN:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_implicit_ -- Check ordering on IMPLICIT statement
+
+   if (ffestc_order_implicit_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_implicit_ ()
+{
+  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:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_implicitnone_ -- Check ordering on IMPLICIT NONE statement
+
+   if (ffestc_order_implicitnone_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_implicitnone_ ()
+{
+  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:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_interface_ -- Check ordering on <interface> statement
+
+   if (ffestc_order_interface_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_interface_ ()
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateINTERFACE0:
+    case FFESTV_stateINTERFACE1:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+      ffestc_shriek_where_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* ffestc_order_map_ -- Check ordering on <map> statement
+
+   if (ffestc_order_map_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_VXT
+static ffestcOrder_
+ffestc_order_map_ ()
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateMAP:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+      ffestc_shriek_where_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* ffestc_order_module_ -- Check ordering on <module> statement
+
+   if (ffestc_order_module_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_module_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateMODULE0:
+    case FFESTV_stateMODULE1:
+    case FFESTV_stateMODULE2:
+    case FFESTV_stateMODULE3:
+    case FFESTV_stateMODULE4:
+    case FFESTV_stateMODULE5:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+      ffestc_shriek_end_uses_ (TRUE);
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+      ffestc_shriek_where_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* ffestc_order_parameter_ -- Check ordering on <parameter> statement
+
+   if (ffestc_order_parameter_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_parameter_ ()
+{
+  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:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_program_ -- Check ordering on <program> statement
+
+   if (ffestc_order_program_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_program_ ()
+{
+  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:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_progspec_ -- Check ordering on <progspec> statement
+
+   if (ffestc_order_progspec_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_progspec_ ()
+{
+  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:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_record_ -- Check ordering on RECORD statement
+
+   if (ffestc_order_record_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_VXT
+static ffestcOrder_
+ffestc_order_record_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_statePROGRAM0:
+    case FFESTV_statePROGRAM1:
+    case FFESTV_statePROGRAM2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateSUBROUTINE1:
+    case FFESTV_stateSUBROUTINE2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateFUNCTION1:
+    case FFESTV_stateFUNCTION2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateMODULE0:
+    case FFESTV_stateMODULE1:
+    case FFESTV_stateMODULE2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateBLOCKDATA0:
+    case FFESTV_stateBLOCKDATA1:
+    case FFESTV_stateBLOCKDATA2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_statePROGRAM3:
+    case FFESTV_stateSUBROUTINE3:
+    case FFESTV_stateFUNCTION3:
+    case FFESTV_stateMODULE3:
+    case FFESTV_stateBLOCKDATA3:
+    case FFESTV_stateSTRUCTURE:
+    case FFESTV_stateMAP:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* ffestc_order_selectcase_ -- Check ordering on <selectcase> statement
+
+   if (ffestc_order_selectcase_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_selectcase_ ()
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateSELECT0:
+    case FFESTV_stateSELECT1:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_sfunc_ -- Check ordering on statement-function definition
+
+   if (ffestc_order_sfunc_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_sfunc_ ()
+{
+  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:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_spec_ -- Check ordering on <spec> statement
+
+   if (ffestc_order_spec_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_spec_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateSUBROUTINE1:
+    case FFESTV_stateSUBROUTINE2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateFUNCTION1:
+    case FFESTV_stateFUNCTION2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateMODULE0:
+    case FFESTV_stateMODULE1:
+    case FFESTV_stateMODULE2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateSUBROUTINE3:
+    case FFESTV_stateFUNCTION3:
+    case FFESTV_stateMODULE3:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* ffestc_order_structure_ -- Check ordering on <structure> statement
+
+   if (ffestc_order_structure_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_VXT
+static ffestcOrder_
+ffestc_order_structure_ ()
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateSTRUCTURE:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* ffestc_order_subroutine_ -- Check ordering on <subroutine> statement
+
+   if (ffestc_order_subroutine_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_subroutine_ ()
+{
+  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:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_type_ -- Check ordering on <type> statement
+
+   if (ffestc_order_type_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_type_ ()
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateTYPE:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+      ffestc_shriek_where_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* ffestc_order_typedecl_ -- Check ordering on <typedecl> statement
+
+   if (ffestc_order_typedecl_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_typedecl_ ()
+{
+  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:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_union_ -- Check ordering on <union> statement
+
+   if (ffestc_order_union_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_VXT
+static ffestcOrder_
+ffestc_order_union_ ()
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateUNION:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* ffestc_order_unit_ -- Check ordering on <unit> statement
+
+   if (ffestc_order_unit_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_unit_ ()
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_use_ -- Check ordering on USE statement
+
+   if (ffestc_order_use_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_use_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_statePROGRAM0:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM1);
+      ffestc_shriek_begin_uses_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateSUBROUTINE0:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE1);
+      ffestc_shriek_begin_uses_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateFUNCTION0:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION1);
+      ffestc_shriek_begin_uses_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateMODULE0:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE1);
+      ffestc_shriek_begin_uses_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateUSE:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+      ffestc_shriek_where_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* ffestc_order_vxtstructure_ -- Check ordering on STRUCTURE statement
+
+   if (ffestc_order_vxtstructure_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_VXT
+static ffestcOrder_
+ffestc_order_vxtstructure_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_statePROGRAM0:
+    case FFESTV_statePROGRAM1:
+    case FFESTV_statePROGRAM2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateSUBROUTINE1:
+    case FFESTV_stateSUBROUTINE2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateFUNCTION1:
+    case FFESTV_stateFUNCTION2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateMODULE0:
+    case FFESTV_stateMODULE1:
+    case FFESTV_stateMODULE2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateBLOCKDATA0:
+    case FFESTV_stateBLOCKDATA1:
+    case FFESTV_stateBLOCKDATA2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_statePROGRAM3:
+    case FFESTV_stateSUBROUTINE3:
+    case FFESTV_stateFUNCTION3:
+    case FFESTV_stateMODULE3:
+    case FFESTV_stateBLOCKDATA3:
+    case FFESTV_stateSTRUCTURE:
+    case FFESTV_stateMAP:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* ffestc_order_where_ -- Check ordering on <where> statement
+
+   if (ffestc_order_where_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_where_ ()
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateWHERETHEN:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+      ffestc_shriek_where_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* Invoked for each token in dummy arg list of FUNCTION, SUBROUTINE, and
+   ENTRY (prior to the first executable statement).  */
+
+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_ ()
+{
+  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_begin_uses_ -- Start a bunch of USE statements
+
+   ffestc_shriek_begin_uses_();
+
+   Invoked before handling the first USE statement in a block of one or
+   more USE statements.	 _end_uses_(bool ok) is invoked before handling
+   the first statement after the block (there are no BEGIN USE and END USE
+   statements, but the semantics of USE statements effectively requires
+   handling them as a single block rather than one statement at a time).  */
+
+#if FFESTR_F90
+static void
+ffestc_shriek_begin_uses_ ()
+{
+  ffestw b;
+
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, NULL);
+  ffestw_set_state (b, FFESTV_stateUSE);
+  ffestw_set_blocknum (b, 0);
+  ffestw_set_shriek (b, ffestc_shriek_end_uses_);
+
+  ffestd_begin_uses ();
+}
+
+#endif
+/* ffestc_shriek_blockdata_ -- End a BLOCK DATA
+
+   ffestc_shriek_blockdata_(TRUE);  */
+
+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_end_uses_ -- End a bunch of USE statements
+
+   ffestc_shriek_end_uses_(TRUE);
+
+   ok==TRUE means simply not popping due to ffestc_eof()
+   being called, because there is no formal END USES statement in Fortran.  */
+
+#if FFESTR_F90
+static void
+ffestc_shriek_end_uses_ (bool ok)
+{
+  ffestd_end_uses (ok);
+
+  ffestw_kill (ffestw_pop ());
+}
+
+#endif
+/* ffestc_shriek_function_ -- End a FUNCTION
+
+   ffestc_shriek_function_(TRUE);  */
+
+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_interface_ -- End an INTERFACE
+
+   ffestc_shriek_interface_(TRUE);  */
+
+#if FFESTR_F90
+static void
+ffestc_shriek_interface_ (bool ok)
+{
+  ffestd_R1203 (ok);
+
+  ffestw_kill (ffestw_pop ());
+
+  ffestc_try_shriek_do_ ();
+}
+
+#endif
+/* ffestc_shriek_map_ -- End a MAP
+
+   ffestc_shriek_map_(TRUE);  */
+
+#if FFESTR_VXT
+static void
+ffestc_shriek_map_ (bool ok)
+{
+  ffestd_V013 (ok);
+
+  ffestw_kill (ffestw_pop ());
+
+  ffestc_try_shriek_do_ ();
+}
+
+#endif
+/* ffestc_shriek_module_ -- End a MODULE
+
+   ffestc_shriek_module_(TRUE);	 */
+
+#if FFESTR_F90
+static void
+ffestc_shriek_module_ (bool ok)
+{
+  if (!ffesta_seen_first_exec)
+    {
+      ffesta_seen_first_exec = TRUE;
+      ffestd_exec_begin ();
+    }
+
+  ffestd_R1106 (ok);
+
+  ffestd_exec_end ();
+
+  ffelex_token_kill (ffestw_name (ffestw_stack_top ()));
+  ffestw_kill (ffestw_pop ());
+
+  ffe_terminate_2 ();
+  ffe_init_2 ();
+}
+
+#endif
+/* ffestc_shriek_select_ -- End a SELECT
+
+   ffestc_shriek_select_(TRUE);	 */
+
+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_structure_ -- End a STRUCTURE
+
+   ffestc_shriek_structure_(TRUE);  */
+
+#if FFESTR_VXT
+static void
+ffestc_shriek_structure_ (bool ok)
+{
+  ffestd_V004 (ok);
+
+  ffestw_kill (ffestw_pop ());
+
+  ffestc_try_shriek_do_ ();
+}
+
+#endif
+/* ffestc_shriek_subroutine_ -- End a SUBROUTINE
+
+   ffestc_shriek_subroutine_(TRUE);  */
+
+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_shriek_type_ -- End a TYPE
+
+   ffestc_shriek_type_(TRUE);  */
+
+#if FFESTR_F90
+static void
+ffestc_shriek_type_ (bool ok)
+{
+  ffestd_R425 (ok);
+
+  ffe_terminate_4 ();
+
+  ffelex_token_kill (ffestw_name (ffestw_stack_top ()));
+  ffestw_kill (ffestw_pop ());
+
+  ffestc_try_shriek_do_ ();
+}
+
+#endif
+/* ffestc_shriek_union_ -- End a UNION
+
+   ffestc_shriek_union_(TRUE);	*/
+
+#if FFESTR_VXT
+static void
+ffestc_shriek_union_ (bool ok)
+{
+  ffestd_V010 (ok);
+
+  ffestw_kill (ffestw_pop ());
+
+  ffestc_try_shriek_do_ ();
+}
+
+#endif
+/* ffestc_shriek_where_ -- Implicit END WHERE statement
+
+   ffestc_shriek_where_(TRUE);
+
+   Implement the end of the current WHERE "block".  ok==TRUE iff statement
+   following WHERE (substatement) is valid; else, statement is invalid
+   or stack forcibly popped due to ffestc_eof().  */
+
+#if FFESTR_F90
+static void
+ffestc_shriek_where_ (bool ok)
+{
+  ffestd_R745 (ok);
+
+  ffestw_kill (ffestw_pop ());
+  ffestc_shriek_after1_ = NULL;
+  if (ffestw_state (ffestw_stack_top ()) == FFESTV_stateIF)
+    ffestc_shriek_if_ (TRUE);	/* "IF (x) WHERE (y) stmt" is only valid
+				   case. */
+
+  ffestc_try_shriek_do_ ();
+}
+
+#endif
+/* ffestc_shriek_wherethen_ -- End a WHERE(-THEN)
+
+   ffestc_shriek_wherethen_(TRUE);  */
+
+#if FFESTR_F90
+static void
+ffestc_shriek_wherethen_ (bool ok)
+{
+  ffestd_end_R740 (ok);
+
+  ffestw_kill (ffestw_pop ());
+
+  ffestc_try_shriek_do_ ();
+}
+
+#endif
+/* ffestc_subr_binsrch_ -- Binary search of char const in list of strings
+
+   i = ffestc_subr_binsrch_(search_list,search_list_size,&spec,"etc");
+
+   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_ (char **list, int size, ffestpFile *spec, char *whine)
+{
+  int lowest_tested;
+  int highest_tested;
+  int halfway;
+  int offset;
+  int c;
+  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_ (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_ (char *string, ffestpFile *spec, 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_ ()
+{
+  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)
+    {
+#if FFESTR_F90
+    case 1:
+      ffestc_R426_start (type, typet, kind, kindt, len, lent);
+      break;
+#endif
+
+    case 2:
+      ffestc_R501_start (type, typet, kind, kindt, len, lent);
+      break;
+
+    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)
+{
+#if FFESTR_F90
+  switch (ffestc_local_.decl.is_R426)
+    {
+    case 1:
+      ffestc_R426_attrib (attrib, attribt, intent_kw, dims);
+      break;
+
+    case 2:
+      ffestc_R501_attrib (attrib, attribt, intent_kw, dims);
+      break;
+
+    default:
+      break;
+    }
+#else
+  ffebad_start (FFEBAD_F90);
+  ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+	       ffelex_token_where_column (ffesta_tokens[0]));
+  ffebad_finish ();
+  return;
+#endif
+}
+
+/* ffestc_decl_item -- R426 or R501
+
+   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)
+    {
+#if FFESTR_F90
+    case 1:
+      ffestc_R426_item (name, kind, kindt, dims, len, lent, init, initt,
+			clist);
+      break;
+#endif
+
+    case 2:
+      ffestc_R501_item (name, kind, kindt, dims, len, lent, init, initt,
+			clist);
+      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 ()
+{
+  switch (ffestc_local_.decl.is_R426)
+    {
+#if FFESTR_F90
+    case 1:
+      ffestc_R426_itemstartvals ();
+      break;
+#endif
+
+    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)
+    {
+#if FFESTR_F90
+    case 1:
+      ffestc_R426_itemvalue (repeat, repeat_token, value, value_token);
+      break;
+#endif
+
+    case 2:
+      ffestc_R501_itemvalue (repeat, repeat_token, value, value_token);
+      break;
+
+    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)
+    {
+#if FFESTR_F90
+    case 1:
+      ffestc_R426_itemendvals (t);
+      break;
+#endif
+
+    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 ()
+{
+  switch (ffestc_local_.decl.is_R426)
+    {
+#if FFESTR_F90
+    case 1:
+      ffestc_R426_finish ();
+      break;
+#endif
+
+    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:
+#if FFESTR_F90
+      ffestc_R744 ();
+#endif
+      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 ()
+{
+  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:
+#if FFESTR_F90
+      ffestc_R1106 (NULL);
+#endif
+      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 ()
+{
+  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 ()
+{
+  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:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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_module -- MODULE or MODULE PROCEDURE statement
+
+   ffestc_module(module_name_token,procedure_name_token);
+
+   Decide which is intended, and implement it by calling _R1105_ or
+   _R1205_.  */
+
+#if FFESTR_F90
+void
+ffestc_module (ffelexToken module, ffelexToken procedure)
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateINTERFACE0:
+    case FFESTV_stateINTERFACE1:
+      ffestc_R1205_start ();
+      ffestc_R1205_item (procedure);
+      ffestc_R1205_finish ();
+      break;
+
+    default:
+      ffestc_R1105 (module);
+      break;
+    }
+}
+
+#endif
+/* ffestc_private -- Generic PRIVATE statement
+
+   ffestc_end();
+
+   This is either a PRIVATE within R422 derived-type statement or an
+   R521 PRIVATE statement.  Figure it out based on context and implement
+   it, or produce an error.  */
+
+#if FFESTR_F90
+void
+ffestc_private ()
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateTYPE:
+      ffestc_R423A ();
+      break;
+
+    default:
+      ffestc_R521B ();
+      break;
+    }
+}
+
+#endif
+/* ffestc_terminate_4 -- Terminate ffestc after scoping unit
+
+   ffestc_terminate_4();
+
+   For SUBROUTINEs/FUNCTIONs within INTERFACE/END INTERFACE, derived-TYPE-
+   defs, and statement function defs.  */
+
+void
+ffestc_terminate_4 ()
+{
+  ffestc_entry_num_ = ffestc_saved_entry_num_;
+}
+
+/* ffestc_R423A -- PRIVATE statement (in R422 derived-type statement)
+
+   ffestc_R423A();  */
+
+#if FFESTR_F90
+void
+ffestc_R423A ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_type_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  if (ffestw_substate (ffestw_stack_top ()) != 0)
+    {
+      ffebad_start (FFEBAD_DERIVTYP_ACCESS_FIRST);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+      ffebad_finish ();
+      return;
+    }
+
+  if (ffestw_state (ffestw_previous (ffestw_stack_top ())) != FFESTV_stateMODULE3)
+    {
+      ffebad_start (FFEBAD_DERIVTYP_ACCESS);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_finish ();
+      return;
+    }
+
+  ffestw_set_substate (ffestw_stack_top (), 1);	/* Seen
+						   private-sequence-stmt. */
+
+  ffestd_R423A ();
+}
+
+/* ffestc_R423B -- SEQUENCE statement (in R422 derived-type-stmt)
+
+   ffestc_R423B();  */
+
+void
+ffestc_R423B ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_type_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  if (ffestw_substate (ffestw_stack_top ()) != 0)
+    {
+      ffebad_start (FFEBAD_DERIVTYP_ACCESS_FIRST);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+      ffebad_finish ();
+      return;
+    }
+
+  ffestw_set_substate (ffestw_stack_top (), 1);	/* Seen
+						   private-sequence-stmt. */
+
+  ffestd_R423B ();
+}
+
+/* ffestc_R424 -- derived-TYPE-def statement
+
+   ffestc_R424(access_token,access_kw,name_token);
+
+   Handle a derived-type definition.  */
+
+void
+ffestc_R424 (ffelexToken access, ffestrOther access_kw, ffelexToken name)
+{
+  ffestw b;
+
+  assert (name != NULL);
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_derivedtype_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  if ((access != NULL)
+      && (ffestw_state (ffestw_stack_top ()) != FFESTV_stateMODULE3))
+    {
+      ffebad_start (FFEBAD_DERIVTYP_ACCESS);
+      ffebad_here (0, ffelex_token_where_line (access),
+		   ffelex_token_where_column (access));
+      ffebad_finish ();
+      access = NULL;
+    }
+
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, NULL);
+  ffestw_set_state (b, FFESTV_stateTYPE);
+  ffestw_set_blocknum (b, 0);
+  ffestw_set_shriek (b, ffestc_shriek_type_);
+  ffestw_set_name (b, ffelex_token_use (name));
+  ffestw_set_substate (b, 0);	/* Awaiting private-sequence-stmt and one
+				   component-def-stmt. */
+
+  ffestd_R424 (access, access_kw, name);
+
+  ffe_init_4 ();
+}
+
+/* ffestc_R425 -- END TYPE statement
+
+   ffestc_R425(name_token);
+
+   Make sure ffestc_kind_ identifies a TYPE definition.	 If not
+   NULL, make sure name_token gives the correct name.  Implement the end
+   of the type definition.  */
+
+void
+ffestc_R425 (ffelexToken name)
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_type_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  if (ffestw_substate (ffestw_stack_top ()) != 2)
+    {
+      ffebad_start (FFEBAD_DERIVTYP_NO_COMPONENTS);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+      ffebad_finish ();
+    }
+
+  if ((name != NULL)
+    && (ffelex_token_strcmp (name, ffestw_name (ffestw_stack_top ())) != 0))
+    {
+      ffebad_start (FFEBAD_TYPE_WRONG_NAME);
+      ffebad_here (0, ffelex_token_where_line (name),
+		   ffelex_token_where_column (name));
+      ffebad_here (1, ffelex_token_where_line (ffestw_name (ffestw_stack_top ())),
+	     ffelex_token_where_column (ffestw_name (ffestw_stack_top ())));
+      ffebad_finish ();
+    }
+
+  ffestc_shriek_type_ (TRUE);
+}
+
+/* ffestc_R426_start -- component-declaration-stmt
+
+   ffestc_R426_start(...);
+
+   Verify that R426 component-declaration-stmt is
+   valid here and implement.  */
+
+void
+ffestc_R426_start (ffestpType type, ffelexToken typet, ffebld kind,
+		   ffelexToken kindt, ffebld len, ffelexToken lent)
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_component_ () != FFESTC_orderOK_)
+    {
+      ffestc_local_.decl.is_R426 = 0;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateSTRUCTURE:
+    case FFESTV_stateMAP:
+      ffestw_set_substate (ffestw_stack_top (), 1);	/* Seen at least one
+							   member. */
+      break;
+
+    case FFESTV_stateTYPE:
+      ffestw_set_substate (ffestw_stack_top (), 2);
+      break;
+
+    default:
+      assert ("Component parent state invalid" == NULL);
+      break;
+    }
+}
+
+/* ffestc_R426_attrib -- type attribute
+
+   ffestc_R426_attrib(...);
+
+   Verify that R426 component-declaration-stmt attribute
+   is valid here and implement.	 */
+
+void
+ffestc_R426_attrib (ffestpAttrib attrib, ffelexToken attribt,
+		    ffestrOther intent_kw, ffesttDimList dims)
+{
+  ffestc_check_attrib_ ();
+}
+
+/* ffestc_R426_item -- declared object
+
+   ffestc_R426_item(...);
+
+   Establish type for a particular object.  */
+
+void
+ffestc_R426_item (ffelexToken name, ffebld kind, ffelexToken kindt,
+	      ffesttDimList dims, ffebld len, ffelexToken lent, ffebld init,
+		  ffelexToken initt, bool clist)
+{
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  assert (ffelex_token_type (name) == FFELEX_typeNAME);	/* Not NAMES. */
+  assert (kind == NULL);	/* No way an expression should get here. */
+
+  if ((dims != NULL) || (init != NULL) || clist)
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+}
+
+/* ffestc_R426_itemstartvals -- Start list of values
+
+   ffestc_R426_itemstartvals();
+
+   Gonna specify values for the object now.  */
+
+void
+ffestc_R426_itemstartvals ()
+{
+  ffestc_check_item_startvals_ ();
+}
+
+/* ffestc_R426_itemvalue -- Source value
+
+   ffestc_R426_itemvalue(repeat,repeat_token,value,value_token);
+
+   Make sure repeat and value are valid for the object being initialized.  */
+
+void
+ffestc_R426_itemvalue (ffebld repeat, ffelexToken repeat_token,
+		       ffebld value, ffelexToken value_token)
+{
+  ffestc_check_item_value_ ();
+}
+
+/* ffestc_R426_itemendvals -- End list of values
+
+   ffelexToken t;  // the SLASH token that ends the list.
+   ffestc_R426_itemendvals(t);
+
+   No more values, might specify more objects now.  */
+
+void
+ffestc_R426_itemendvals (ffelexToken t)
+{
+  ffestc_check_item_endvals_ ();
+}
+
+/* ffestc_R426_finish -- Done
+
+   ffestc_R426_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R426_finish ()
+{
+  ffestc_check_finish_ ();
+}
+
+#endif
+/* ffestc_R501_start -- type-declaration-stmt
+
+   ffestc_R501_start(...);
+
+   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)
+    {
+#if FFESTR_F90
+    case FFESTP_attribALLOCATABLE:
+      break;
+#endif
+
+    case FFESTP_attribDIMENSION:
+      ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+      break;
+
+    case FFESTP_attribEXTERNAL:
+      break;
+
+#if FFESTR_F90
+    case FFESTP_attribINTENT:
+      break;
+#endif
+
+    case FFESTP_attribINTRINSIC:
+      break;
+
+#if FFESTR_F90
+    case FFESTP_attribOPTIONAL:
+      break;
+#endif
+
+    case FFESTP_attribPARAMETER:
+      break;
+
+#if FFESTR_F90
+    case FFESTP_attribPOINTER:
+      break;
+#endif
+
+#if FFESTR_F90
+    case FFESTP_attribPRIVATE:
+      break;
+
+    case FFESTP_attribPUBLIC:
+      break;
+#endif
+
+    case FFESTP_attribSAVE:
+      switch (ffestv_save_state_)
+	{
+	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;
+
+#if FFESTR_F90
+    case FFESTP_attribTARGET:
+      break;
+#endif
+
+    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 ()
+{
+  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 ()
+{
+  ffestc_check_finish_ ();
+}
+
+/* ffestc_R519_start -- INTENT statement list begin
+
+   ffestc_R519_start();
+
+   Verify that INTENT is valid here, and begin accepting items in the list.  */
+
+#if FFESTR_F90
+void
+ffestc_R519_start (ffelexToken intent, ffestrOther intent_kw)
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_spec_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  ffestd_R519_start (intent_kw);
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R519_item -- INTENT statement for name
+
+   ffestc_R519_item(name_token);
+
+   Make sure name_token identifies a valid object to be INTENTed.  */
+
+void
+ffestc_R519_item (ffelexToken name)
+{
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R519_item (name);
+}
+
+/* ffestc_R519_finish -- INTENT statement list complete
+
+   ffestc_R519_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R519_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R519_finish ();
+}
+
+/* ffestc_R520_start -- OPTIONAL statement list begin
+
+   ffestc_R520_start();
+
+   Verify that OPTIONAL is valid here, and begin accepting items in the list.  */
+
+void
+ffestc_R520_start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_spec_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  ffestd_R520_start ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R520_item -- OPTIONAL statement for name
+
+   ffestc_R520_item(name_token);
+
+   Make sure name_token identifies a valid object to be OPTIONALed.  */
+
+void
+ffestc_R520_item (ffelexToken name)
+{
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R520_item (name);
+}
+
+/* ffestc_R520_finish -- OPTIONAL statement list complete
+
+   ffestc_R520_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R520_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R520_finish ();
+}
+
+/* ffestc_R521A -- PUBLIC statement
+
+   ffestc_R521A();
+
+   Verify that PUBLIC is valid here.  */
+
+void
+ffestc_R521A ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_access_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  switch (ffestv_access_state_)
+    {
+    case FFESTV_accessstateNONE:
+      ffestv_access_state_ = FFESTV_accessstatePUBLIC;
+      ffestv_access_line_
+	= ffewhere_line_use (ffelex_token_where_line (ffesta_tokens[0]));
+      ffestv_access_col_
+	= ffewhere_column_use (ffelex_token_where_column (ffesta_tokens[0]));
+      break;
+
+    case FFESTV_accessstateANY:
+      break;
+
+    case FFESTV_accessstatePUBLIC:
+    case FFESTV_accessstatePRIVATE:
+      ffebad_start (FFEBAD_CONFLICTING_ACCESSES);
+      ffebad_here (0, ffestv_access_line_, ffestv_access_col_);
+      ffebad_here (1, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_finish ();
+      ffestv_access_state_ = FFESTV_accessstateANY;
+      break;
+
+    default:
+      assert ("unexpected access state" == NULL);
+      break;
+    }
+
+  ffestd_R521A ();
+}
+
+/* ffestc_R521Astart -- PUBLIC statement list begin
+
+   ffestc_R521Astart();
+
+   Verify that PUBLIC is valid here, and begin accepting items in the list.  */
+
+void
+ffestc_R521Astart ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_access_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  ffestd_R521Astart ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R521Aitem -- PUBLIC statement for name
+
+   ffestc_R521Aitem(name_token);
+
+   Make sure name_token identifies a valid object to be PUBLICed.  */
+
+void
+ffestc_R521Aitem (ffelexToken name)
+{
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R521Aitem (name);
+}
+
+/* ffestc_R521Afinish -- PUBLIC statement list complete
+
+   ffestc_R521Afinish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R521Afinish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R521Afinish ();
+}
+
+/* ffestc_R521B -- PRIVATE statement
+
+   ffestc_R521B();
+
+   Verify that PRIVATE is valid here (outside a derived-type statement).  */
+
+void
+ffestc_R521B ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_access_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  switch (ffestv_access_state_)
+    {
+    case FFESTV_accessstateNONE:
+      ffestv_access_state_ = FFESTV_accessstatePRIVATE;
+      ffestv_access_line_
+	= ffewhere_line_use (ffelex_token_where_line (ffesta_tokens[0]));
+      ffestv_access_col_
+	= ffewhere_column_use (ffelex_token_where_column (ffesta_tokens[0]));
+      break;
+
+    case FFESTV_accessstateANY:
+      break;
+
+    case FFESTV_accessstatePUBLIC:
+    case FFESTV_accessstatePRIVATE:
+      ffebad_start (FFEBAD_CONFLICTING_ACCESSES);
+      ffebad_here (0, ffestv_access_line_, ffestv_access_col_);
+      ffebad_here (1, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_finish ();
+      ffestv_access_state_ = FFESTV_accessstateANY;
+      break;
+
+    default:
+      assert ("unexpected access state" == NULL);
+      break;
+    }
+
+  ffestd_R521B ();
+}
+
+/* ffestc_R521Bstart -- PRIVATE statement list begin
+
+   ffestc_R521Bstart();
+
+   Verify that PRIVATE is valid here, and begin accepting items in the list.  */
+
+void
+ffestc_R521Bstart ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_access_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  ffestd_R521Bstart ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R521Bitem -- PRIVATE statement for name
+
+   ffestc_R521Bitem(name_token);
+
+   Make sure name_token identifies a valid object to be PRIVATEed.  */
+
+void
+ffestc_R521Bitem (ffelexToken name)
+{
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R521Bitem (name);
+}
+
+/* ffestc_R521Bfinish -- PRIVATE statement list complete
+
+   ffestc_R521Bfinish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R521Bfinish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R521Bfinish ();
+}
+
+#endif
+/* ffestc_R522 -- SAVE statement with no list
+
+   ffestc_R522();
+
+   Verify that SAVE is valid here, and flag everything as SAVEd.  */
+
+void
+ffestc_R522 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R524_finish ();
+}
+
+/* ffestc_R525_start -- ALLOCATABLE statement list begin
+
+   ffestc_R525_start();
+
+   Verify that ALLOCATABLE is valid here, and begin accepting items in the
+   list.  */
+
+#if FFESTR_F90
+void
+ffestc_R525_start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_progspec_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  ffestd_R525_start ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R525_item -- ALLOCATABLE statement for object-name
+
+   ffestc_R525_item(name_token,dim_list);
+
+   Make sure name_token identifies a valid object to be ALLOCATABLEd.  */
+
+void
+ffestc_R525_item (ffelexToken name, ffesttDimList dims)
+{
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+
+  ffestd_R525_item (name, dims);
+}
+
+/* ffestc_R525_finish -- ALLOCATABLE statement list complete
+
+   ffestc_R525_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R525_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R525_finish ();
+}
+
+/* ffestc_R526_start -- POINTER statement list begin
+
+   ffestc_R526_start();
+
+   Verify that POINTER is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestc_R526_start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_progspec_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  ffestd_R526_start ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R526_item -- POINTER statement for object-name
+
+   ffestc_R526_item(name_token,dim_list);
+
+   Make sure name_token identifies a valid object to be POINTERd.  */
+
+void
+ffestc_R526_item (ffelexToken name, ffesttDimList dims)
+{
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+
+  ffestd_R526_item (name, dims);
+}
+
+/* ffestc_R526_finish -- POINTER statement list complete
+
+   ffestc_R526_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R526_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R526_finish ();
+}
+
+/* ffestc_R527_start -- TARGET statement list begin
+
+   ffestc_R527_start();
+
+   Verify that TARGET is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestc_R527_start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_progspec_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  ffestd_R527_start ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R527_item -- TARGET statement for object-name
+
+   ffestc_R527_item(name_token,dim_list);
+
+   Make sure name_token identifies a valid object to be TARGETd.  */
+
+void
+ffestc_R527_item (ffelexToken name, ffesttDimList dims)
+{
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+
+  ffestd_R527_item (name, dims);
+}
+
+/* ffestc_R527_finish -- TARGET statement list complete
+
+   ffestc_R527_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R527_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R527_finish ();
+}
+
+#endif
+/* ffestc_R528_start -- DATA statement list begin
+
+   ffestc_R528_start();
+
+   Verify that DATA is valid here, and begin accepting items in the list.  */
+
+void
+ffestc_R528_start ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  if (ffestc_local_.common.symbol != NULL)
+    ffesymbol_signal_unreported (ffestc_local_.common.symbol);
+
+  ffestd_R547_finish ();
+}
+
+/* ffestc_R620 -- ALLOCATE statement
+
+   ffestc_R620(exprlist,stat,stat_token);
+
+   Make sure the expression list is valid, then implement it.  */
+
+#if FFESTR_F90
+void
+ffestc_R620 (ffesttExprList exprlist, ffebld stat, ffelexToken stat_token)
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  ffestd_R620 (exprlist, stat);
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R624 -- NULLIFY statement
+
+   ffestc_R624(pointer_name_list);
+
+   Make sure pointer_name_list identifies valid pointers for a NULLIFY.	 */
+
+void
+ffestc_R624 (ffesttExprList pointers)
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  ffestd_R624 (pointers);
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R625 -- DEALLOCATE statement
+
+   ffestc_R625(exprlist,stat,stat_token);
+
+   Make sure the equivalence is valid, then implement it.  */
+
+void
+ffestc_R625 (ffesttExprList exprlist, ffebld stat, ffelexToken stat_token)
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  ffestd_R625 (exprlist, stat);
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+#endif
+/* ffestc_let -- R1213 or R737
+
+   ffestc_let(...);
+
+   Verify that R1213 defined-assignment or R737 assignment-stmt are
+   valid here, figure out which one, and implement.  */
+
+#if FFESTR_F90
+void
+ffestc_let (ffebld dest, ffebld source, ffelexToken source_token)
+{
+  ffestc_R737 (dest, source, source_token);
+}
+
+#endif
+/* ffestc_R737 -- Assignment statement
+
+   ffestc_R737(dest_expr,source_expr,source_token);
+
+   Make sure the assignment is valid.  */
+
+void
+ffestc_R737 (ffebld dest, ffebld source, ffelexToken source_token)
+{
+  ffestc_check_simple_ ();
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+#if FFESTR_F90
+    case FFESTV_stateWHERE:
+    case FFESTV_stateWHERETHEN:
+      if (ffestc_order_actionwhere_ () != FFESTC_orderOK_)
+	return;
+      ffestc_labeldef_useless_ ();
+
+      ffestd_R737B (dest, source);
+
+      if (ffestc_shriek_after1_ != NULL)
+	(*ffestc_shriek_after1_) (TRUE);
+      return;
+#endif
+
+    default:
+      break;
+    }
+
+  if (ffestc_order_actionwhere_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  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_R738 -- Pointer assignment statement
+
+   ffestc_R738(dest_expr,source_expr,source_token);
+
+   Make sure the assignment is valid.  */
+
+#if FFESTR_F90
+void
+ffestc_R738 (ffebld dest, ffebld source, ffelexToken source_token)
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  ffestd_R738 (dest, source);
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R740 -- WHERE statement
+
+   ffestc_R740(expr,expr_token);
+
+   Make sure statement is valid here; implement.  */
+
+void
+ffestc_R740 (ffebld expr, ffelexToken expr_token)
+{
+  ffestw b;
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, ffestw_top_do (ffestw_previous (b)));
+  ffestw_set_state (b, FFESTV_stateWHERE);
+  ffestw_set_blocknum (b, ffestc_blocknum_++);
+  ffestw_set_shriek (b, ffestc_shriek_where_lost_);
+
+  ffestd_R740 (expr);
+
+  /* Leave label finishing to next statement. */
+
+}
+
+/* ffestc_R742 -- WHERE-construct statement
+
+   ffestc_R742(expr,expr_token);
+
+   Make sure statement is valid here; implement.  */
+
+void
+ffestc_R742 (ffebld expr, ffelexToken expr_token)
+{
+  ffestw b;
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_exec_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_notloop_probably_this_wont_work_ ();
+
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, ffestw_top_do (ffestw_previous (b)));
+  ffestw_set_state (b, FFESTV_stateWHERETHEN);
+  ffestw_set_blocknum (b, ffestc_blocknum_++);
+  ffestw_set_shriek (b, ffestc_shriek_wherethen_);
+  ffestw_set_substate (b, 0);	/* Haven't seen ELSEWHERE yet. */
+
+  ffestd_R742 (expr);
+}
+
+/* ffestc_R744 -- ELSE WHERE statement
+
+   ffestc_R744();
+
+   Make sure ffestc_kind_ identifies a WHERE block.
+   Implement the ELSE of the current WHERE block.  */
+
+void
+ffestc_R744 ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_where_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  if (ffestw_substate (ffestw_stack_top ()) != 0)
+    {
+      ffebad_start (FFEBAD_SECOND_ELSE_WHERE);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+      ffebad_finish ();
+    }
+
+  ffestw_set_substate (ffestw_stack_top (), 1);	/* Saw ELSEWHERE. */
+
+  ffestd_R744 ();
+}
+
+/* ffestc_R745 -- END WHERE statement
+
+   ffestc_R745();
+
+   Make sure ffestc_kind_ identifies a WHERE block.
+   Implement the end of the current WHERE block.  */
+
+void
+ffestc_R745 ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_where_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  ffestc_shriek_wherethen_ (TRUE);
+}
+
+#endif
+/* ffestc_R803 -- Block IF (IF-THEN) statement
+
+   ffestc_R803(construct_name,expr,expr_token);
+
+   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 = (ffestwSelect) 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)))
+	      || ((caseobj->range)
+		  && (caseobj->expr2 != NULL)
+		  && ((ffeinfo_basictype (ffebld_info (caseobj->expr2))
+		       != s->type)
+		      || (ffeinfo_kindtype (ffebld_info (caseobj->expr2))
+			  != s->kindtype))))
+	    {
+	      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_ ();
+
+  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 ()
+{
+  ffestc_check_simple_ ();
+
+  if (ffestc_order_actionwhere_ () != FFESTC_orderOK_)
+    return;
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+#if FFESTR_F90
+    case FFESTV_stateWHERE:
+    case FFESTV_stateWHERETHEN:
+      ffestc_labeldef_useless_ ();
+
+      ffestd_R841 (TRUE);
+
+      /* It's okay that we call ffestc_labeldef_branch_end_ () below,
+	 since that will be a no-op after calling _useless_ () above.  */
+      break;
+#endif
+
+    default:
+      ffestc_labeldef_branch_begin_ ();
+
+      ffestd_R841 (FALSE);
+
+      break;
+    }
+
+  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 ()
+{
+  int i;
+  int expect_file;
+  char *status_strs[]
+  =
+  {
+    "New",
+    "Old",
+    "Replace",
+    "Scratch",
+    "Unknown"
+  };
+  char *access_strs[]
+  =
+  {
+    "Append",
+    "Direct",
+    "Keyed",
+    "Sequential"
+  };
+  char *blank_strs[]
+  =
+  {
+    "Null",
+    "Zero"
+  };
+  char *carriagecontrol_strs[]
+  =
+  {
+    "Fortran",
+    "List",
+    "None"
+  };
+  char *dispose_strs[]
+  =
+  {
+    "Delete",
+    "Keep",
+    "Print",
+    "Print/Delete",
+    "Save",
+    "Submit",
+    "Submit/Delete"
+  };
+  char *form_strs[]
+  =
+  {
+    "Formatted",
+    "Unformatted"
+  };
+  char *organization_strs[]
+  =
+  {
+    "Indexed",
+    "Relative",
+    "Sequential"
+  };
+  char *position_strs[]
+  =
+  {
+    "Append",
+    "AsIs",
+    "Rewind"
+  };
+  char *action_strs[]
+  =
+  {
+    "Read",
+    "ReadWrite",
+    "Write"
+  };
+  char *delim_strs[]
+  =
+  {
+    "Apostrophe",
+    "None",
+    "Quote"
+  };
+  char *recordtype_strs[]
+  =
+  {
+    "Fixed",
+    "Segmented",
+    "Stream",
+    "Stream_CR",
+    "Stream_LF",
+    "Variable"
+  };
+  char *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 ()
+{
+  char *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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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_R1105 -- MODULE statement
+
+   ffestc_R1105(name_token);
+
+   Make sure ffestc_kind_ identifies an empty block.  Make sure name_token
+   gives a valid name.	Implement the beginning of a module.  */
+
+#if FFESTR_F90
+void
+ffestc_R1105 (ffelexToken name)
+{
+  ffestw b;
+
+  assert (name != NULL);
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_unit_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  ffestc_blocknum_ = 0;
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, NULL);
+  ffestw_set_state (b, FFESTV_stateMODULE0);
+  ffestw_set_blocknum (b, ffestc_blocknum_++);
+  ffestw_set_shriek (b, ffestc_shriek_module_);
+  ffestw_set_name (b, ffelex_token_use (name));
+
+  ffestd_R1105 (name);
+}
+
+/* ffestc_R1106 -- END MODULE statement
+
+   ffestc_R1106(name_token);
+
+   Make sure ffestc_kind_ identifies the current kind of program unit.	If not
+   NULL, make sure name_token gives the correct name.  Implement the end
+   of the current program unit.	 */
+
+void
+ffestc_R1106 (ffelexToken name)
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_module_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  if ((name != NULL)
+      && (ffelex_token_strcmp (name, ffestw_name (ffestw_stack_top ())) != 0))
+    {
+      ffebad_start (FFEBAD_UNIT_WRONG_NAME);
+      ffebad_here (0, ffelex_token_where_line (name),
+		   ffelex_token_where_column (name));
+      ffebad_here (1, ffelex_token_where_line (ffestw_name (ffestw_stack_top ())),
+	     ffelex_token_where_column (ffestw_name (ffestw_stack_top ())));
+      ffebad_finish ();
+    }
+
+  ffestc_shriek_module_ (TRUE);
+}
+
+/* ffestc_R1107_start -- USE statement list begin
+
+   ffestc_R1107_start();
+
+   Verify that USE is valid here, and begin accepting items in the list.  */
+
+void
+ffestc_R1107_start (ffelexToken name, bool only)
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_use_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  ffestd_R1107_start (name, only);
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R1107_item -- USE statement for name
+
+   ffestc_R1107_item(local_token,use_token);
+
+   Make sure name_token identifies a valid object to be USEed.	local_token
+   may be NULL if _start_ was called with only==TRUE.  */
+
+void
+ffestc_R1107_item (ffelexToken local, ffelexToken use)
+{
+  ffestc_check_item_ ();
+  assert (use != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R1107_item (local, use);
+}
+
+/* ffestc_R1107_finish -- USE statement list complete
+
+   ffestc_R1107_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R1107_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R1107_finish ();
+}
+
+#endif
+/* ffestc_R1111 -- BLOCK DATA statement
+
+   ffestc_R1111(name_token);
+
+   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_R1202 -- INTERFACE statement
+
+   ffestc_R1202(operator,defined_name);
+
+   Make sure ffestc_kind_ identifies an INTERFACE block.
+   Implement the end of the current interface.
+
+   15-May-90  JCB  1.1
+      Allow no operator or name to mean INTERFACE by itself; missed this
+      valid form when originally doing syntactic analysis code.	 */
+
+#if FFESTR_F90
+void
+ffestc_R1202 (ffestpDefinedOperator operator, ffelexToken name)
+{
+  ffestw b;
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_interfacespec_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, NULL);
+  ffestw_set_state (b, FFESTV_stateINTERFACE0);
+  ffestw_set_blocknum (b, 0);
+  ffestw_set_shriek (b, ffestc_shriek_interface_);
+
+  if ((operator == FFESTP_definedoperatorNone) && (name == NULL))
+    ffestw_set_substate (b, 0);	/* No generic-spec, so disallow MODULE
+				   PROCEDURE. */
+  else
+    ffestw_set_substate (b, 1);	/* MODULE PROCEDURE ok. */
+
+  ffestd_R1202 (operator, name);
+
+  ffe_init_4 ();
+}
+
+/* ffestc_R1203 -- END INTERFACE statement
+
+   ffestc_R1203();
+
+   Make sure ffestc_kind_ identifies an INTERFACE block.
+   Implement the end of the current interface.	*/
+
+void
+ffestc_R1203 ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_interface_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  ffestc_shriek_interface_ (TRUE);
+
+  ffe_terminate_4 ();
+}
+
+/* ffestc_R1205_start -- MODULE PROCEDURE statement list begin
+
+   ffestc_R1205_start();
+
+   Verify that MODULE PROCEDURE is valid here, and begin accepting items in
+   the list.  */
+
+void
+ffestc_R1205_start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_interface_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  if (ffestw_substate (ffestw_stack_top ()) == 0)
+    {
+      ffebad_start (FFEBAD_INVALID_MODULE_PROCEDURE);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+      ffebad_finish ();
+      ffestc_ok_ = FALSE;
+      return;
+    }
+
+  if (ffestw_state (ffestw_stack_top ()) == FFESTV_stateINTERFACE0)
+    {
+      ffestw_update (NULL);	/* Update state line/col info. */
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateINTERFACE1);
+    }
+
+  ffestd_R1205_start ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R1205_item -- MODULE PROCEDURE statement for name
+
+   ffestc_R1205_item(name_token);
+
+   Make sure name_token identifies a valid object to be MODULE PROCEDUREed.  */
+
+void
+ffestc_R1205_item (ffelexToken name)
+{
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R1205_item (name);
+}
+
+/* ffestc_R1205_finish -- MODULE PROCEDURE statement list complete
+
+   ffestc_R1205_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R1205_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R1205_finish ();
+}
+
+#endif
+/* ffestc_R1207_start -- EXTERNAL statement list begin
+
+   ffestc_R1207_start();
+
+   Verify that EXTERNAL is valid here, and begin accepting items in the list.  */
+
+void
+ffestc_R1207_start ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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_R1213 -- Defined assignment statement
+
+   ffestc_R1213(dest_expr,source_expr,source_token);
+
+   Make sure the assignment is valid.  */
+
+#if FFESTR_F90
+void
+ffestc_R1213 (ffebld dest, ffebld source, ffelexToken source_token)
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  ffestd_R1213 (dest, source);
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+#endif
+/* ffestc_R1219 -- FUNCTION statement
+
+   ffestc_R1219(funcname,arglist,ending_token,kind,kindt,len,lent,
+	 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_R1228 -- CONTAINS statement
+
+   ffestc_R1228();  */
+
+#if FFESTR_F90
+void
+ffestc_R1228 ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_contains_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  ffestd_R1228 ();
+
+  ffe_terminate_3 ();
+  ffe_init_3 ();
+}
+
+#endif
+/* ffestc_R1229_start -- STMTFUNCTION statement begin
+
+   ffestc_R1229_start(func_name,func_arg_list,close_paren);
+
+   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 ());
+	  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_V003_start -- STRUCTURE statement list begin
+
+   ffestc_V003_start(structure_name);
+
+   Verify that STRUCTURE is valid here, and begin accepting items in the list.	*/
+
+#if FFESTR_VXT
+void
+ffestc_V003_start (ffelexToken structure_name)
+{
+  ffestw b;
+
+  ffestc_check_start_ ();
+  if (ffestc_order_vxtstructure_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateSTRUCTURE:
+    case FFESTV_stateMAP:
+      ffestc_local_.V003.list_state = 2;	/* Require at least one field
+						   name. */
+      ffestw_set_substate (ffestw_stack_top (), 1);	/* Seen at least one
+							   member. */
+      break;
+
+    default:
+      ffestc_local_.V003.list_state = 0;	/* No field names required. */
+      if (structure_name == NULL)
+	{
+	  ffebad_start (FFEBAD_STRUCT_MISSING_NAME);
+	  ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		       ffelex_token_where_column (ffesta_tokens[0]));
+	  ffebad_finish ();
+	}
+      break;
+    }
+
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, NULL);
+  ffestw_set_state (b, FFESTV_stateSTRUCTURE);
+  ffestw_set_blocknum (b, 0);
+  ffestw_set_shriek (b, ffestc_shriek_structure_);
+  ffestw_set_substate (b, 0);	/* No field-declarations seen yet. */
+
+  ffestd_V003_start (structure_name);
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_V003_item -- STRUCTURE statement for object-name
+
+   ffestc_V003_item(name_token,dim_list);
+
+   Make sure name_token identifies a valid object to be STRUCTUREd.  */
+
+void
+ffestc_V003_item (ffelexToken name, ffesttDimList dims)
+{
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  if (ffestc_local_.V003.list_state < 2)
+    {
+      if (ffestc_local_.V003.list_state == 0)
+	{
+	  ffestc_local_.V003.list_state = 1;
+	  ffebad_start (FFEBAD_STRUCT_IGNORING_FIELD);
+	  ffebad_here (0, ffelex_token_where_line (name),
+		       ffelex_token_where_column (name));
+	  ffebad_finish ();
+	}
+      return;
+    }
+  ffestc_local_.V003.list_state = 3;	/* Have at least one field name. */
+
+  if (dims != NULL)
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+
+  ffestd_V003_item (name, dims);
+}
+
+/* ffestc_V003_finish -- STRUCTURE statement list complete
+
+   ffestc_V003_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_V003_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  if (ffestc_local_.V003.list_state == 2)
+    {
+      ffebad_start (FFEBAD_STRUCT_MISSING_FIELD);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_here (1, ffestw_line (ffestw_previous (ffestw_stack_top ())),
+		   ffestw_col (ffestw_previous (ffestw_stack_top ())));
+      ffebad_finish ();
+    }
+
+  ffestd_V003_finish ();
+}
+
+/* ffestc_V004 -- END STRUCTURE statement
+
+   ffestc_V004();
+
+   Make sure ffestc_kind_ identifies a STRUCTURE block.
+   Implement the end of the current STRUCTURE block.  */
+
+void
+ffestc_V004 ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_structure_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  if (ffestw_substate (ffestw_stack_top ()) != 1)
+    {
+      ffebad_start (FFEBAD_STRUCT_NO_COMPONENTS);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+      ffebad_finish ();
+    }
+
+  ffestc_shriek_structure_ (TRUE);
+}
+
+/* ffestc_V009 -- UNION statement
+
+   ffestc_V009();  */
+
+void
+ffestc_V009 ()
+{
+  ffestw b;
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_structure_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  ffestw_set_substate (ffestw_stack_top (), 1);	/* Seen at least one member. */
+
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, NULL);
+  ffestw_set_state (b, FFESTV_stateUNION);
+  ffestw_set_blocknum (b, 0);
+  ffestw_set_shriek (b, ffestc_shriek_union_);
+  ffestw_set_substate (b, 0);	/* No map decls seen yet. */
+
+  ffestd_V009 ();
+}
+
+/* ffestc_V010 -- END UNION statement
+
+   ffestc_V010();
+
+   Make sure ffestc_kind_ identifies a UNION block.
+   Implement the end of the current UNION block.  */
+
+void
+ffestc_V010 ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_union_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  if (ffestw_substate (ffestw_stack_top ()) != 2)
+    {
+      ffebad_start (FFEBAD_UNION_NO_TWO_MAPS);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+      ffebad_finish ();
+    }
+
+  ffestc_shriek_union_ (TRUE);
+}
+
+/* ffestc_V012 -- MAP statement
+
+   ffestc_V012();  */
+
+void
+ffestc_V012 ()
+{
+  ffestw b;
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_union_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  if (ffestw_substate (ffestw_stack_top ()) != 2)
+    ffestw_substate (ffestw_stack_top ())++;	/* 0=>1, 1=>2. */
+
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, NULL);
+  ffestw_set_state (b, FFESTV_stateMAP);
+  ffestw_set_blocknum (b, 0);
+  ffestw_set_shriek (b, ffestc_shriek_map_);
+  ffestw_set_substate (b, 0);	/* No field-declarations seen yet. */
+
+  ffestd_V012 ();
+}
+
+/* ffestc_V013 -- END MAP statement
+
+   ffestc_V013();
+
+   Make sure ffestc_kind_ identifies a MAP block.
+   Implement the end of the current MAP block.	*/
+
+void
+ffestc_V013 ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_map_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  if (ffestw_substate (ffestw_stack_top ()) != 1)
+    {
+      ffebad_start (FFEBAD_MAP_NO_COMPONENTS);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+      ffebad_finish ();
+    }
+
+  ffestc_shriek_map_ (TRUE);
+}
+
+#endif
+/* ffestc_V014_start -- VOLATILE statement list begin
+
+   ffestc_V014_start();
+
+   Verify that VOLATILE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestc_V014_start ()
+{
+  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 ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V014_finish ();
+}
+
+/* ffestc_V016_start -- RECORD statement list begin
+
+   ffestc_V016_start();
+
+   Verify that RECORD is valid here, and begin accepting items in the list.  */
+
+#if FFESTR_VXT
+void
+ffestc_V016_start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_record_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateSTRUCTURE:
+    case FFESTV_stateMAP:
+      ffestw_set_substate (ffestw_stack_top (), 1);	/* Seen at least one
+							   member. */
+      break;
+
+    default:
+      break;
+    }
+
+  ffestd_V016_start ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_V016_item_structure -- RECORD statement for common-block-name
+
+   ffestc_V016_item_structure(name_token);
+
+   Make sure name_token identifies a valid structure to be RECORDed.  */
+
+void
+ffestc_V016_item_structure (ffelexToken name)
+{
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V016_item_structure (name);
+}
+
+/* ffestc_V016_item_object -- RECORD statement for object-name
+
+   ffestc_V016_item_object(name_token,dim_list);
+
+   Make sure name_token identifies a valid object to be RECORDd.  */
+
+void
+ffestc_V016_item_object (ffelexToken name, ffesttDimList dims)
+{
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  if (dims != NULL)
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+
+  ffestd_V016_item_object (name, dims);
+}
+
+/* ffestc_V016_finish -- RECORD statement list complete
+
+   ffestc_V016_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_V016_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V016_finish ();
+}
+
+/* ffestc_V018_start -- REWRITE(...) statement list begin
+
+   ffestc_V018_start();
+
+   Verify that REWRITE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestc_V018_start ()
+{
+  ffestvFormat format;
+
+  ffestc_check_start_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_branch_begin_ ();
+
+  if (!ffestc_subr_is_branch_
+      (&ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixERR])
+      || !ffestc_subr_is_format_
+      (&ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT])
+      || !ffestc_subr_is_present_ ("UNIT",
+		   &ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT]))
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+
+  format = ffestc_subr_format_
+    (&ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT]);
+  switch (format)
+    {
+    case FFESTV_formatNAMELIST:
+    case FFESTV_formatASTERISK:
+      ffebad_start (FFEBAD_CONFLICTING_SPECS);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      assert (ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw_or_val_present);
+      if (ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw_present)
+	{
+	  ffebad_here (0, ffelex_token_where_line
+		 (ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw),
+		       ffelex_token_where_column
+		(ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw));
+	}
+      else
+	{
+	  ffebad_here (1, ffelex_token_where_line
+	      (ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value),
+		       ffelex_token_where_column
+	     (ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value));
+	}
+      ffebad_finish ();
+      ffestc_ok_ = FALSE;
+      return;
+
+    default:
+      break;
+    }
+
+  ffestd_V018_start (format);
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_V018_item -- REWRITE statement i/o item
+
+   ffestc_V018_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffestc_V018_item (ffebld expr, ffelexToken expr_token)
+{
+  ffestc_check_item_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V018_item (expr);
+}
+
+/* ffestc_V018_finish -- REWRITE statement list complete
+
+   ffestc_V018_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_V018_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V018_finish ();
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_V019_start -- ACCEPT statement list begin
+
+   ffestc_V019_start();
+
+   Verify that ACCEPT is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestc_V019_start ()
+{
+  ffestvFormat format;
+
+  ffestc_check_start_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_branch_begin_ ();
+
+  if (!ffestc_subr_is_format_
+      (&ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT]))
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+
+  format = ffestc_subr_format_
+    (&ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT]);
+  ffestc_namelist_ = (format == FFESTV_formatNAMELIST);
+
+  ffestd_V019_start (format);
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_V019_item -- ACCEPT statement i/o item
+
+   ffestc_V019_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffestc_V019_item (ffebld expr, ffelexToken expr_token)
+{
+  ffestc_check_item_ ();
+  if (!ffestc_ok_)
+    return;
+
+  if (ffestc_namelist_ != 0)
+    {
+      if (ffestc_namelist_ == 1)
+	{
+	  ffestc_namelist_ = 2;
+	  ffebad_start (FFEBAD_NAMELIST_ITEMS);
+	  ffebad_here (0, ffelex_token_where_line (expr_token),
+		       ffelex_token_where_column (expr_token));
+	  ffebad_finish ();
+	}
+      return;
+    }
+
+  ffestd_V019_item (expr);
+}
+
+/* ffestc_V019_finish -- ACCEPT statement list complete
+
+   ffestc_V019_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_V019_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V019_finish ();
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+#endif
+/* ffestc_V020_start -- TYPE statement list begin
+
+   ffestc_V020_start();
+
+   Verify that TYPE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestc_V020_start ()
+{
+  ffestvFormat format;
+
+  ffestc_check_start_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_branch_begin_ ();
+
+  if (!ffestc_subr_is_format_
+      (&ffestp_file.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 ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V020_finish ();
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_V021 -- DELETE statement
+
+   ffestc_V021();
+
+   Make sure a DELETE is valid in the current context, and implement it.  */
+
+#if FFESTR_VXT
+void
+ffestc_V021 ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  if (ffestc_subr_is_branch_
+      (&ffestp_file.delete.delete_spec[FFESTP_deleteixERR])
+      && ffestc_subr_is_present_ ("UNIT",
+		      &ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT]))
+    ffestd_V021 ();
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_V022 -- UNLOCK statement
+
+   ffestc_V022();
+
+   Make sure a UNLOCK is valid in the current context, and implement it.  */
+
+void
+ffestc_V022 ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  if (ffestc_subr_is_branch_
+      (&ffestp_file.beru.beru_spec[FFESTP_beruixERR])
+      && ffestc_subr_is_present_ ("UNIT",
+			    &ffestp_file.beru.beru_spec[FFESTP_beruixUNIT]))
+    ffestd_V022 ();
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_V023_start -- ENCODE(...) statement list begin
+
+   ffestc_V023_start();
+
+   Verify that ENCODE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestc_V023_start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_branch_begin_ ();
+
+  if (!ffestc_subr_is_branch_
+      (&ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixERR]))
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+
+  ffestd_V023_start ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_V023_item -- ENCODE statement i/o item
+
+   ffestc_V023_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffestc_V023_item (ffebld expr, ffelexToken expr_token)
+{
+  ffestc_check_item_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V023_item (expr);
+}
+
+/* ffestc_V023_finish -- ENCODE statement list complete
+
+   ffestc_V023_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_V023_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V023_finish ();
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_V024_start -- DECODE(...) statement list begin
+
+   ffestc_V024_start();
+
+   Verify that DECODE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestc_V024_start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_branch_begin_ ();
+
+  if (!ffestc_subr_is_branch_
+      (&ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixERR]))
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+
+  ffestd_V024_start ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_V024_item -- DECODE statement i/o item
+
+   ffestc_V024_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffestc_V024_item (ffebld expr, ffelexToken expr_token)
+{
+  ffestc_check_item_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V024_item (expr);
+}
+
+/* ffestc_V024_finish -- DECODE statement list complete
+
+   ffestc_V024_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_V024_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V024_finish ();
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_V025_start -- DEFINEFILE statement list begin
+
+   ffestc_V025_start();
+
+   Verify that DEFINEFILE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestc_V025_start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_branch_begin_ ();
+
+  ffestd_V025_start ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_V025_item -- DEFINE FILE statement item
+
+   ffestc_V025_item(u,ut,m,mt,n,nt,asv,asvt);
+
+   Implement item.  */
+
+void
+ffestc_V025_item (ffebld u, ffelexToken ut, ffebld m, ffelexToken mt,
+		  ffebld n, ffelexToken nt, ffebld asv, ffelexToken asvt)
+{
+  ffestc_check_item_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V025_item (u, m, n, asv);
+}
+
+/* ffestc_V025_finish -- DEFINE FILE statement list complete
+
+   ffestc_V025_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_V025_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V025_finish ();
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_V026 -- FIND statement
+
+   ffestc_V026();
+
+   Make sure a FIND is valid in the current context, and implement it.	*/
+
+void
+ffestc_V026 ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  if (ffestc_subr_is_branch_
+      (&ffestp_file.find.find_spec[FFESTP_findixERR])
+      && ffestc_subr_is_present_ ("UNIT",
+			     &ffestp_file.find.find_spec[FFESTP_findixUNIT])
+      && ffestc_subr_is_present_ ("REC",
+			     &ffestp_file.find.find_spec[FFESTP_findixREC]))
+    ffestd_V026 ();
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+#endif
+/* ffestc_V027_start -- VXT PARAMETER statement list begin
+
+   ffestc_V027_start();
+
+   Verify that PARAMETER is valid here, and begin accepting items in the list.	*/
+
+void
+ffestc_V027_start ()
+{
+  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 ()
+{
+  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 ()
+{
+  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
new file mode 100644
index 00000000000..d5cc601b945
--- /dev/null
+++ b/gcc/f/stc.h
@@ -0,0 +1,360 @@
+/* stc.h -- Private #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_stc
+#define _H_f_stc
+
+/* 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);
+#if FFESTR_F90
+void ffestc_let (ffebld dest, ffebld source, ffelexToken source_token);
+#else
+#define ffestc_let ffestc_R737
+#endif
+#if FFESTR_F90
+void ffestc_module (ffelexToken module_name, ffelexToken procedure_name);
+#endif
+#if FFESTR_F90
+void ffestc_private (void);
+#endif
+void ffestc_terminate_4 (void);
+#if FFESTR_F90
+void ffestc_R423A (void);
+void ffestc_R423B (void);
+void ffestc_R424 (ffelexToken access, ffestrOther access_kw, ffelexToken name);
+void ffestc_R425 (ffelexToken name);
+void ffestc_R426_start (ffestpType type, ffelexToken typet, ffebld kind,
+			ffelexToken kindt, ffebld len, ffelexToken lent);
+void ffestc_R426_attrib (ffestpAttrib attrib, ffelexToken attribt,
+			 ffestrOther intent_kw, ffesttDimList dims);
+void ffestc_R426_item (ffelexToken name, ffebld kind, ffelexToken kindt,
+	      ffesttDimList dims, ffebld len, ffelexToken lent, ffebld init,
+		       ffelexToken initt, bool clist);
+void ffestc_R426_itemstartvals (void);
+void ffestc_R426_itemvalue (ffebld repeat, ffelexToken repeat_token,
+			    ffebld value, ffelexToken value_token);
+void ffestc_R426_itemendvals (ffelexToken t);
+void ffestc_R426_finish (void);
+#endif
+void ffestc_R501_start (ffestpType type, ffelexToken typet, ffebld kind,
+			ffelexToken kindt, ffebld len, ffelexToken lent);
+void ffestc_R501_attrib (ffestpAttrib attrib, ffelexToken attribt,
+			 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);
+#if FFESTR_F90
+void ffestc_R519_start (ffelexToken intent, ffestrOther intent_kw);
+void ffestc_R519_item (ffelexToken name);
+void ffestc_R519_finish (void);
+void ffestc_R520_start (void);
+void ffestc_R520_item (ffelexToken name);
+void ffestc_R520_finish (void);
+void ffestc_R521A (void);
+void ffestc_R521Astart (void);
+void ffestc_R521Aitem (ffelexToken name);
+void ffestc_R521Afinish (void);
+void ffestc_R521B (void);
+void ffestc_R521Bstart (void);
+void ffestc_R521Bitem (ffelexToken name);
+void ffestc_R521Bfinish (void);
+#endif
+void ffestc_R522 (void);
+void ffestc_R522start (void);
+void ffestc_R522item_object (ffelexToken name);
+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);
+#if FFESTR_F90
+void ffestc_R525_start (void);
+void ffestc_R525_item (ffelexToken name, ffesttDimList dims);
+void ffestc_R525_finish (void);
+void ffestc_R526_start (void);
+void ffestc_R526_item (ffelexToken name, ffesttDimList dims);
+void ffestc_R526_finish (void);
+void ffestc_R527_start (void);
+void ffestc_R527_item (ffelexToken name, ffesttDimList dims);
+void ffestc_R527_finish (void);
+#endif
+void ffestc_R528_start (void);
+void ffestc_R528_item_object (ffebld expr, ffelexToken expr_token);
+void ffestc_R528_item_startvals (void);
+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);
+#if FFESTR_F90
+void ffestc_R620 (ffesttExprList objects, ffebld stat,
+		  ffelexToken stat_token);
+void ffestc_R624 (ffesttExprList pointers);
+void ffestc_R625 (ffesttExprList objects, ffebld stat,
+		  ffelexToken stat_token);
+#endif
+void ffestc_R737 (ffebld dest, ffebld source, ffelexToken source_token);
+#if FFESTR_F90
+void ffestc_R738 (ffebld dest, ffebld source, ffelexToken source_token);
+void ffestc_R740 (ffebld expr, ffelexToken expr_token);
+void ffestc_R742 (ffebld expr, ffelexToken expr_token);
+void ffestc_R744 (void);
+void ffestc_R745 (void);
+#endif
+void ffestc_R803 (ffelexToken construct_name, ffebld expr,
+		  ffelexToken expr_token);
+void ffestc_R804 (ffebld expr, ffelexToken expr_token, ffelexToken name);
+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);
+#if FFESTR_F90
+void ffestc_R1105 (ffelexToken name);
+void ffestc_R1106 (ffelexToken name);
+void ffestc_R1107_start (ffelexToken name, bool only);
+void ffestc_R1107_item (ffelexToken local, ffelexToken use);
+void ffestc_R1107_finish (void);
+#endif
+void ffestc_R1111 (ffelexToken name);
+void ffestc_R1112 (ffelexToken name);
+#if FFESTR_F90
+void ffestc_R1202 (ffestpDefinedOperator operator, ffelexToken name);
+void ffestc_R1203 (void);
+void ffestc_R1205_start (void);
+void ffestc_R1205_item (ffelexToken name);
+void ffestc_R1205_finish (void);
+#endif
+void ffestc_R1207_start (void);
+void ffestc_R1207_item (ffelexToken name);
+void ffestc_R1207_finish (void);
+void ffestc_R1208_start (void);
+void ffestc_R1208_item (ffelexToken name);
+void ffestc_R1208_finish (void);
+void ffestc_R1212 (ffebld expr, ffelexToken expr_token);
+#if FFESTR_F90
+void ffestc_R1213 (ffebld dest, ffebld source, ffelexToken source_token);
+#endif
+void ffestc_R1219 (ffelexToken funcname, ffesttTokenList args,
+	 ffelexToken final, ffestpType type, ffebld kind, ffelexToken kindt,
+   ffebld len, ffelexToken lent, ffelexToken recursive, ffelexToken result);
+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);
+#if FFESTR_F90
+void ffestc_R1228 (void);
+#endif
+void ffestc_R1229_start (ffelexToken name, ffesttTokenList args,
+			 ffelexToken final);
+void ffestc_R1229_finish (ffebld expr, ffelexToken expr_token);
+void ffestc_S3P4 (ffebld filename, ffelexToken filename_token);
+#if FFESTR_VXT
+void ffestc_V003_start (ffelexToken structure_name);
+void ffestc_V003_item (ffelexToken name, ffesttDimList dims);
+void ffestc_V003_finish (void);
+void ffestc_V004 (void);
+void ffestc_V009 (void);
+void ffestc_V010 (void);
+void ffestc_V012 (void);
+void ffestc_V013 (void);
+#endif
+void ffestc_V014_start (void);
+void ffestc_V014_item_object (ffelexToken name);
+void ffestc_V014_item_cblock (ffelexToken name);
+void ffestc_V014_finish (void);
+#if FFESTR_VXT
+void ffestc_V016_start (void);
+void ffestc_V016_item_structure (ffelexToken name);
+void ffestc_V016_item_object (ffelexToken name, ffesttDimList dims);
+void ffestc_V016_finish (void);
+void ffestc_V018_start (void);
+void ffestc_V018_item (ffebld expr, ffelexToken expr_token);
+void ffestc_V018_finish (void);
+void ffestc_V019_start (void);
+void ffestc_V019_item (ffebld expr, ffelexToken expr_token);
+void ffestc_V019_finish (void);
+#endif
+void ffestc_V020_start (void);
+void ffestc_V020_item (ffebld expr, ffelexToken expr_token);
+void ffestc_V020_finish (void);
+#if FFESTR_VXT
+void ffestc_V021 (void);
+void ffestc_V022 (void);
+void ffestc_V023_start (void);
+void ffestc_V023_item (ffebld expr, ffelexToken expr_token);
+void ffestc_V023_finish (void);
+void ffestc_V024_start (void);
+void ffestc_V024_item (ffebld expr, ffelexToken expr_token);
+void ffestc_V024_finish (void);
+void ffestc_V025_start (void);
+void ffestc_V025_item (ffebld u, ffelexToken ut, ffebld m, ffelexToken mt,
+		    ffebld n, ffelexToken nt, ffebld asv, ffelexToken asvt);
+void ffestc_V025_finish (void);
+void ffestc_V026 (void);
+#endif
+void ffestc_V027_start (void);
+void ffestc_V027_item (ffelexToken dest_token, ffebld source,
+		       ffelexToken source_token);
+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
diff --git a/gcc/f/std.c b/gcc/f/std.c
new file mode 100644
index 00000000000..ea497425d9c
--- /dev/null
+++ b/gcc/f/std.c
@@ -0,0 +1,6739 @@
+/* std.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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_;
+
+#if FFECOM_TWOPASS
+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 */
+#if FFESTR_VXT
+    FFESTD_stmtidV018_,		/* REWRITE */
+    FFESTD_stmtidV019_,		/* ACCEPT */
+#endif
+    FFESTD_stmtidV020_,		/* TYPE */
+#if FFESTR_VXT
+    FFESTD_stmtidV021_,		/* DELETE */
+    FFESTD_stmtidV022_,		/* UNLOCK */
+    FFESTD_stmtidV023_,		/* ENCODE */
+    FFESTD_stmtidV024_,		/* DECODE */
+    FFESTD_stmtidV025start_,	/* DEFINEFILE (start) */
+    FFESTD_stmtidV025item_,	/* (DEFINEFILE item) */
+    FFESTD_stmtidV025finish_,	/* (DEFINEFILE finish) */
+    FFESTD_stmtidV026_,		/* FIND */
+#endif
+    FFESTD_stmtid_,
+  } ffestdStmtId_;
+
+#endif
+
+/* Internal typedefs. */
+
+typedef struct _ffestd_expr_item_ *ffestdExprItem_;
+#if FFECOM_TWOPASS
+typedef struct _ffestd_stmt_ *ffestdStmt_;
+#endif
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+struct _ffestd_expr_item_
+  {
+    ffestdExprItem_ next;
+    ffebld expr;
+    ffelexToken token;
+  };
+
+#if FFECOM_TWOPASS
+struct _ffestd_stmt_
+  {
+    ffestdStmt_ next;
+    ffestdStmt_ previous;
+    ffestdStmtId_ id;
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+    char *filename;
+    int filelinenum;
+#endif
+    union
+      {
+	struct
+	  {
+	    ffestw block;
+	  }
+	enddoloop;
+	struct
+	  {
+	    ffelab label;
+	  }
+	execlabel;
+	struct
+	  {
+	    ffelab label;
+	  }
+	formatlabel;
+	struct
+	  {
+	    mallocPool pool;
+	    ffebld dest;
+	    ffebld source;
+	  }
+	R737A;
+	struct
+	  {
+	    mallocPool pool;
+	    ffebld expr;
+	  }
+	R803;
+	struct
+	  {
+	    mallocPool pool;
+	    ffebld expr;
+	  }
+	R804;
+	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;
+#if FFESTR_VXT
+	struct
+	  {
+	    mallocPool pool;
+	    ffestpRewriteStmt *params;
+	    ffestvFormat format;
+	    ffestdExprItem_ list;
+	  }
+	V018;
+	struct
+	  {
+	    mallocPool pool;
+	    ffestpAcceptStmt *params;
+	    ffestvFormat format;
+	    ffestdExprItem_ list;
+	  }
+	V019;
+#endif
+	struct
+	  {
+	    mallocPool pool;
+	    ffestpTypeStmt *params;
+	    ffestvFormat format;
+	    ffestdExprItem_ list;
+	  }
+	V020;
+#if FFESTR_VXT
+	struct
+	  {
+	    mallocPool pool;
+	    ffestpDeleteStmt *params;
+	  }
+	V021;
+	struct
+	  {
+	    mallocPool pool;
+	    ffestpBeruStmt *params;
+	  }
+	V022;
+	struct
+	  {
+	    mallocPool pool;
+	    ffestpVxtcodeStmt *params;
+	    ffestdExprItem_ list;
+	  }
+	V023;
+	struct
+	  {
+	    mallocPool pool;
+	    ffestpVxtcodeStmt *params;
+	    ffestdExprItem_ list;
+	  }
+	V024;
+	struct
+	  {
+	    ffebld u;
+	    ffebld m;
+	    ffebld n;
+	    ffebld asv;
+	  }
+	V025item;
+	struct
+	  {
+	    mallocPool pool;
+	  } V025finish;
+	struct
+	  {
+	    mallocPool pool;
+	    ffestpFindStmt *params;
+	  }
+	V026;
+#endif
+      }
+    u;
+  };
+
+#endif
+
+/* Static objects accessed by functions in this module. */
+
+static ffestdStatelet_ ffestd_statelet_ = FFESTD_stateletSIMPLE_;
+static int ffestd_block_level_ = 0;	/* Block level for reachableness. */
+static bool ffestd_is_reachable_;	/* Is the current stmt reachable?  */
+static ffelab ffestd_label_formatdef_ = NULL;
+#if FFECOM_TWOPASS
+static ffestdExprItem_ *ffestd_expr_list_;
+static struct
+  {
+    ffestdStmt_ first;
+    ffestdStmt_ last;
+  }
+
+ffestd_stmt_list_
+=
+{
+  NULL, NULL
+};
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static int ffestd_2pass_entrypoints_ = 0;	/* # ENTRY statements
+						   pending. */
+#endif
+
+/* Static functions (internal). */
+
+#if FFECOM_TWOPASS
+static void ffestd_stmt_append_ (ffestdStmt_ stmt);
+static ffestdStmt_ ffestd_stmt_new_ (ffestdStmtId_ id);
+static void ffestd_stmt_pass_ (void);
+#endif
+#if FFESTD_COPY_EASY_ && FFECOM_TWOPASS
+static ffestpInquireStmt *ffestd_subr_copy_easy_ (ffestpInquireIx max);
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void ffestd_subr_vxt_ (void);
+#endif
+#if FFESTR_F90
+static void ffestd_subr_f90_ (void);
+#endif
+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,
+				      char *string);
+static void ffestd_R1001dump_1005_2_ (ffests s, ffesttFormatList f,
+				      char *string);
+static void ffestd_R1001dump_1005_3_ (ffests s, ffesttFormatList f,
+				      char *string);
+static void ffestd_R1001dump_1005_4_ (ffests s, ffesttFormatList f,
+				      char *string);
+static void ffestd_R1001dump_1005_5_ (ffests s, ffesttFormatList f,
+				      char *string);
+static void ffestd_R1001dump_1010_1_ (ffests s, ffesttFormatList f,
+				      char *string);
+static void ffestd_R1001dump_1010_2_ (ffests s, ffesttFormatList f,
+				      char *string);
+static void ffestd_R1001dump_1010_3_ (ffests s, ffesttFormatList f,
+				      char *string);
+static void ffestd_R1001dump_1010_4_ (ffests s, ffesttFormatList f,
+				      char *string);
+static void ffestd_R1001dump_1010_5_ (ffests s, ffesttFormatList f,
+				      char *string);
+static void ffestd_R1001error_ (ffesttFormatList f);
+
+/* Internal macros. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#define ffestd_subr_line_now_()					       \
+  ffeste_set_line (ffelex_token_where_filename (ffesta_tokens[0]), \
+		   ffelex_token_where_filelinenum (ffesta_tokens[0]))
+#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]))
+#else
+#define ffestd_subr_line_now_()
+#if FFECOM_TWOPASS
+#define ffestd_subr_line_restore_(s)
+#define ffestd_subr_line_save_(s)
+#endif	/* FFECOM_TWOPASS */
+#endif	/* FFECOM_targetCURRENT != FFECOM_targetGCC */
+#define ffestd_check_simple_() \
+      assert(ffestd_statelet_ == FFESTD_stateletSIMPLE_)
+#define ffestd_check_start_() \
+      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_ && FFECOM_TWOPASS
+#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_));	*/
+
+#if FFECOM_TWOPASS
+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;
+}
+
+#endif
+/* ffestd_stmt_new_ -- Make new statement with given id
+
+   ffestdStmt_ stmt;
+   stmt = ffestd_stmt_new_(FFESTD_stmtidR737A_);  */
+
+#if FFECOM_TWOPASS
+static ffestdStmt_
+ffestd_stmt_new_ (ffestdStmtId_ id)
+{
+  ffestdStmt_ stmt;
+
+  stmt = malloc_new_kp (ffe_pool_any_unit (), "ffestdStmt_", sizeof (*stmt));
+  stmt->id = id;
+  return stmt;
+}
+
+#endif
+/* ffestd_stmt_pass_ -- Pass all statements on list to ffeste
+
+   ffestd_stmt_pass_();	 */
+
+#if FFECOM_TWOPASS
+static void
+ffestd_stmt_pass_ ()
+{
+  ffestdStmt_ stmt;
+  ffestdExprItem_ expr;		/* For traversing lists. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+  if (ffestd_2pass_entrypoints_ != 0)
+    {
+      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");
+      push_momentary ();
+
+      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);
+	      clear_momentary ();
+
+	      ffesymbol_hook (stmt->u.R1226.entry).length_tree = label;
+	    }
+	  stmt = stmt->next;
+	}
+      while (--ents != 0);
+
+      pop_momentary ();
+      expand_end_case (which);
+      clear_momentary ();
+    }
+#endif
+
+  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);
+	  ffeste_do (stmt->u.enddoloop.block);
+	  ffestw_kill (stmt->u.enddoloop.block);
+	  break;
+
+	case FFESTD_stmtidENDLOGIF_:
+	  ffestd_subr_line_restore_ (stmt);
+	  ffeste_end_R807 ();
+	  break;
+
+	case FFESTD_stmtidEXECLABEL_:
+	  ffeste_labeldef_branch (stmt->u.execlabel.label);
+	  break;
+
+	case FFESTD_stmtidFORMATLABEL_:
+	  ffeste_labeldef_format (stmt->u.formatlabel.label);
+	  break;
+
+	case FFESTD_stmtidR737A_:
+	  ffestd_subr_line_restore_ (stmt);
+	  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);
+	  ffeste_R803 (stmt->u.R803.expr);
+	  malloc_pool_kill (stmt->u.R803.pool);
+	  break;
+
+	case FFESTD_stmtidR804_:
+	  ffestd_subr_line_restore_ (stmt);
+	  ffeste_R804 (stmt->u.R804.expr);
+	  malloc_pool_kill (stmt->u.R804.pool);
+	  break;
+
+	case FFESTD_stmtidR805_:
+	  ffestd_subr_line_restore_ (stmt);
+	  ffeste_R805 ();
+	  break;
+
+	case FFESTD_stmtidR806_:
+	  ffestd_subr_line_restore_ (stmt);
+	  ffeste_R806 ();
+	  break;
+
+	case FFESTD_stmtidR807_:
+	  ffestd_subr_line_restore_ (stmt);
+	  ffeste_R807 (stmt->u.R807.expr);
+	  malloc_pool_kill (stmt->u.R807.pool);
+	  break;
+
+	case FFESTD_stmtidR809_:
+	  ffestd_subr_line_restore_ (stmt);
+	  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);
+	  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);
+	  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);
+	  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);
+	  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);
+	  ffeste_R825 ();
+	  break;
+
+	case FFESTD_stmtidR834_:
+	  ffestd_subr_line_restore_ (stmt);
+	  ffeste_R834 (stmt->u.R834.block);
+	  break;
+
+	case FFESTD_stmtidR835_:
+	  ffestd_subr_line_restore_ (stmt);
+	  ffeste_R835 (stmt->u.R835.block);
+	  break;
+
+	case FFESTD_stmtidR836_:
+	  ffestd_subr_line_restore_ (stmt);
+	  ffeste_R836 (stmt->u.R836.label);
+	  break;
+
+	case FFESTD_stmtidR837_:
+	  ffestd_subr_line_restore_ (stmt);
+	  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);
+	  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);
+	  ffeste_R839 (stmt->u.R839.target);
+	  malloc_pool_kill (stmt->u.R839.pool);
+	  break;
+
+	case FFESTD_stmtidR840_:
+	  ffestd_subr_line_restore_ (stmt);
+	  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);
+	  ffeste_R841 ();
+	  break;
+
+	case FFESTD_stmtidR842_:
+	  ffestd_subr_line_restore_ (stmt);
+	  ffeste_R842 (stmt->u.R842.expr);
+	  malloc_pool_kill (stmt->u.R842.pool);
+	  break;
+
+	case FFESTD_stmtidR843_:
+	  ffestd_subr_line_restore_ (stmt);
+	  ffeste_R843 (stmt->u.R843.expr);
+	  malloc_pool_kill (stmt->u.R843.pool);
+	  break;
+
+	case FFESTD_stmtidR904_:
+	  ffestd_subr_line_restore_ (stmt);
+	  ffeste_R904 (stmt->u.R904.params);
+	  malloc_pool_kill (stmt->u.R904.pool);
+	  break;
+
+	case FFESTD_stmtidR907_:
+	  ffestd_subr_line_restore_ (stmt);
+	  ffeste_R907 (stmt->u.R907.params);
+	  malloc_pool_kill (stmt->u.R907.pool);
+	  break;
+
+	case FFESTD_stmtidR909_:
+	  ffestd_subr_line_restore_ (stmt);
+	  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)
+	    {
+	      ffeste_R909_item (expr->expr, expr->token);
+	      ffelex_token_kill (expr->token);
+	    }
+	  ffeste_R909_finish ();
+	  malloc_pool_kill (stmt->u.R909.pool);
+	  break;
+
+	case FFESTD_stmtidR910_:
+	  ffestd_subr_line_restore_ (stmt);
+	  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)
+	    {
+	      ffeste_R910_item (expr->expr, expr->token);
+	      ffelex_token_kill (expr->token);
+	    }
+	  ffeste_R910_finish ();
+	  malloc_pool_kill (stmt->u.R910.pool);
+	  break;
+
+	case FFESTD_stmtidR911_:
+	  ffestd_subr_line_restore_ (stmt);
+	  ffeste_R911_start (stmt->u.R911.params, stmt->u.R911.format);
+	  for (expr = stmt->u.R911.list; expr != NULL; expr = expr->next)
+	    {
+	      ffeste_R911_item (expr->expr, expr->token);
+	      ffelex_token_kill (expr->token);
+	    }
+	  ffeste_R911_finish ();
+	  malloc_pool_kill (stmt->u.R911.pool);
+	  break;
+
+	case FFESTD_stmtidR919_:
+	  ffestd_subr_line_restore_ (stmt);
+	  ffeste_R919 (stmt->u.R919.params);
+	  malloc_pool_kill (stmt->u.R919.pool);
+	  break;
+
+	case FFESTD_stmtidR920_:
+	  ffestd_subr_line_restore_ (stmt);
+	  ffeste_R920 (stmt->u.R920.params);
+	  malloc_pool_kill (stmt->u.R920.pool);
+	  break;
+
+	case FFESTD_stmtidR921_:
+	  ffestd_subr_line_restore_ (stmt);
+	  ffeste_R921 (stmt->u.R921.params);
+	  malloc_pool_kill (stmt->u.R921.pool);
+	  break;
+
+	case FFESTD_stmtidR923A_:
+	  ffestd_subr_line_restore_ (stmt);
+	  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);
+	  ffeste_R923B_start (stmt->u.R923B.params);
+	  for (expr = stmt->u.R923B.list; expr != NULL; expr = expr->next)
+	    ffeste_R923B_item (expr->expr);
+	  ffeste_R923B_finish ();
+	  malloc_pool_kill (stmt->u.R923B.pool);
+	  break;
+
+	case FFESTD_stmtidR1001_:
+	  ffeste_R1001 (&stmt->u.R1001.str);
+	  ffests_kill (&stmt->u.R1001.str);
+	  break;
+
+	case FFESTD_stmtidR1103_:
+	  ffeste_R1103 ();
+	  break;
+
+	case FFESTD_stmtidR1112_:
+	  ffeste_R1112 ();
+	  break;
+
+	case FFESTD_stmtidR1212_:
+	  ffestd_subr_line_restore_ (stmt);
+	  ffeste_R1212 (stmt->u.R1212.expr);
+	  malloc_pool_kill (stmt->u.R1212.pool);
+	  break;
+
+	case FFESTD_stmtidR1221_:
+	  ffeste_R1221 ();
+	  break;
+
+	case FFESTD_stmtidR1225_:
+	  ffeste_R1225 ();
+	  break;
+
+	case FFESTD_stmtidR1226_:
+	  ffestd_subr_line_restore_ (stmt);
+	  if (stmt->u.R1226.entry != NULL)
+	    ffeste_R1226 (stmt->u.R1226.entry);
+	  break;
+
+	case FFESTD_stmtidR1227_:
+	  ffestd_subr_line_restore_ (stmt);
+	  ffeste_R1227 (stmt->u.R1227.block, stmt->u.R1227.expr);
+	  malloc_pool_kill (stmt->u.R1227.pool);
+	  break;
+
+#if FFESTR_VXT
+	case FFESTD_stmtidV018_:
+	  ffestd_subr_line_restore_ (stmt);
+	  ffeste_V018_start (stmt->u.V018.params, stmt->u.V018.format);
+	  for (expr = stmt->u.V018.list; expr != NULL; expr = expr->next)
+	    ffeste_V018_item (expr->expr);
+	  ffeste_V018_finish ();
+	  malloc_pool_kill (stmt->u.V018.pool);
+	  break;
+
+	case FFESTD_stmtidV019_:
+	  ffestd_subr_line_restore_ (stmt);
+	  ffeste_V019_start (stmt->u.V019.params, stmt->u.V019.format);
+	  for (expr = stmt->u.V019.list; expr != NULL; expr = expr->next)
+	    ffeste_V019_item (expr->expr);
+	  ffeste_V019_finish ();
+	  malloc_pool_kill (stmt->u.V019.pool);
+	  break;
+#endif
+
+	case FFESTD_stmtidV020_:
+	  ffestd_subr_line_restore_ (stmt);
+	  ffeste_V020_start (stmt->u.V020.params, stmt->u.V020.format);
+	  for (expr = stmt->u.V020.list; expr != NULL; expr = expr->next)
+	    ffeste_V020_item (expr->expr);
+	  ffeste_V020_finish ();
+	  malloc_pool_kill (stmt->u.V020.pool);
+	  break;
+
+#if FFESTR_VXT
+	case FFESTD_stmtidV021_:
+	  ffestd_subr_line_restore_ (stmt);
+	  ffeste_V021 (stmt->u.V021.params);
+	  malloc_pool_kill (stmt->u.V021.pool);
+	  break;
+
+	case FFESTD_stmtidV023_:
+	  ffestd_subr_line_restore_ (stmt);
+	  ffeste_V023_start (stmt->u.V023.params);
+	  for (expr = stmt->u.V023.list; expr != NULL; expr = expr->next)
+	    ffeste_V023_item (expr->expr);
+	  ffeste_V023_finish ();
+	  malloc_pool_kill (stmt->u.V023.pool);
+	  break;
+
+	case FFESTD_stmtidV024_:
+	  ffestd_subr_line_restore_ (stmt);
+	  ffeste_V024_start (stmt->u.V024.params);
+	  for (expr = stmt->u.V024.list; expr != NULL; expr = expr->next)
+	    ffeste_V024_item (expr->expr);
+	  ffeste_V024_finish ();
+	  malloc_pool_kill (stmt->u.V024.pool);
+	  break;
+
+	case FFESTD_stmtidV025start_:
+	  ffestd_subr_line_restore_ (stmt);
+	  ffeste_V025_start ();
+	  break;
+
+	case FFESTD_stmtidV025item_:
+	  ffeste_V025_item (stmt->u.V025item.u, stmt->u.V025item.m,
+			    stmt->u.V025item.n, stmt->u.V025item.asv);
+	  break;
+
+	case FFESTD_stmtidV025finish_:
+	  ffeste_V025_finish ();
+	  malloc_pool_kill (stmt->u.V025finish.pool);
+	  break;
+
+	case FFESTD_stmtidV026_:
+	  ffestd_subr_line_restore_ (stmt);
+	  ffeste_V026 (stmt->u.V026.params);
+	  malloc_pool_kill (stmt->u.V026.pool);
+	  break;
+#endif
+
+	default:
+	  assert ("bad stmt->id" == NULL);
+	  break;
+	}
+    }
+}
+
+#endif
+/* 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_ && FFECOM_TWOPASS
+static ffestpInquireStmt *
+ffestd_subr_copy_easy_ (ffestpInquireIx max)
+{
+  ffestpInquireStmt *stmt;
+  ffestpInquireIx ix;
+
+  stmt = (ffestpInquireStmt *) 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_f90_ -- Report error about lack of full F90 support
+
+   ffestd_subr_f90_();	*/
+
+#if FFESTR_F90
+static void
+ffestd_subr_f90_ ()
+{
+  ffebad_start (FFEBAD_F90);
+  ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+	       ffelex_token_where_column (ffesta_tokens[0]));
+  ffebad_finish ();
+}
+
+#endif
+/* ffestd_subr_vxt_ -- Report error about lack of full VXT support
+
+   ffestd_subr_vxt_();	*/
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffestd_subr_vxt_ ()
+{
+  ffebad_start (FFEBAD_VXT_UNSUPPORTED);
+  ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+	       ffelex_token_where_column (ffesta_tokens[0]));
+  ffebad_finish ();
+}
+
+#endif
+/* 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 ()
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("; begin_uses\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_do -- End of statement following DO-term-stmt etc
+
+   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)
+{
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_do (ffestw_stack_top ());
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidENDDOLOOP_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.enddoloop.block = ffestw_stack_top ();
+  }
+#endif
+
+  --ffestd_block_level_;
+  assert (ffestd_block_level_ >= 0);
+}
+
+/* ffestd_end_uses -- End a bunch of USE statements
+
+   ffestd_end_uses(TRUE);
+
+   ok==TRUE means simply not popping due to ffestd_eof_()
+   being called, because there is no formal END USES statement in Fortran.  */
+
+#if FFESTR_F90
+void
+ffestd_end_uses (bool ok)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("; end_uses\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_end_R740 -- End a WHERE(-THEN)
+
+   ffestd_end_R740(TRUE);  */
+
+void
+ffestd_end_R740 (bool ok)
+{
+  return;			/* F90. */
+}
+
+#endif
+/* ffestd_end_R807 -- End of statement following logical IF
+
+   ffestd_end_R807(TRUE);
+
+   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)
+{
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_end_R807 ();
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidENDLOGIF_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+  }
+#endif
+
+  --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 ()
+{
+  ffecom_exec_transition ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("{ begin_exec\n", dmpout);
+#endif
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+  if (ffestd_2pass_entrypoints_ != 0)
+    {				/* Process pending ENTRY statements now that
+				   info filled in. */
+      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);
+    }
+#endif
+}
+
+/* ffestd_exec_end -- Executable statements can no longer come in now
+
+   ffestd_exec_end();  */
+
+void
+ffestd_exec_end ()
+{
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+  int old_lineno = lineno;
+  char *old_input_filename = input_filename;
+#endif
+
+  ffecom_end_transition ();
+
+#if FFECOM_TWOPASS
+  ffestd_stmt_pass_ ();
+#endif
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("} end_exec\n", dmpout);
+  fputs ("> end_unit\n", dmpout);
+#endif
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffecom_finish_progunit ();
+
+  if (ffestd_2pass_entrypoints_ != 0)
+    {
+      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;
+
+  lineno = old_lineno;
+  input_filename = old_input_filename;
+#endif
+}
+
+/* ffestd_init_3 -- Initialize for any program unit
+
+   ffestd_init_3();  */
+
+void
+ffestd_init_3 ()
+{
+#if FFECOM_TWOPASS
+  ffestd_stmt_list_.first = (ffestdStmt_) &ffestd_stmt_list_.first;
+  ffestd_stmt_list_.last = (ffestdStmt_) &ffestd_stmt_list_.first;
+#endif
+}
+
+/* Generate "code" for "any" label def.  */
+
+void
+ffestd_labeldef_any (ffelab label UNUSED)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "; any_label_def %lu\n", ffelab_value (label));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_labeldef_branch -- Generate "code" for branch label def
+
+   ffestd_labeldef_branch(label);  */
+
+void
+ffestd_labeldef_branch (ffelab label)
+{
+#if FFECOM_ONEPASS
+  ffeste_labeldef_branch (label);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidEXECLABEL_);
+    ffestd_stmt_append_ (stmt);
+    stmt->u.execlabel.label = label;
+  }
+#endif
+
+  ffestd_is_reachable_ = TRUE;
+}
+
+/* ffestd_labeldef_format -- Generate "code" for FORMAT label def
+
+   ffestd_labeldef_format(label);  */
+
+void
+ffestd_labeldef_format (ffelab label)
+{
+  ffestd_label_formatdef_ = label;
+
+#if FFECOM_ONEPASS
+  ffeste_labeldef_format (label);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidFORMATLABEL_);
+    ffestd_stmt_append_ (stmt);
+    stmt->u.formatlabel.label = label;
+  }
+#endif
+}
+
+/* ffestd_labeldef_useless -- Generate "code" for useless label def
+
+   ffestd_labeldef_useless(label);  */
+
+void
+ffestd_labeldef_useless (ffelab label UNUSED)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "; useless_label_def %lu\n", ffelab_value (label));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R423A -- PRIVATE statement (in R422 derived-type statement)
+
+   ffestd_R423A();  */
+
+#if FFESTR_F90
+void
+ffestd_R423A ()
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("* PRIVATE_derived_type\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R423B -- SEQUENCE statement (in R422 derived-type-stmt)
+
+   ffestd_R423B();  */
+
+void
+ffestd_R423B ()
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("* SEQUENCE_derived_type\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R424 -- derived-TYPE-def statement
+
+   ffestd_R424(access_token,access_kw,name_token);
+
+   Handle a derived-type definition.  */
+
+void
+ffestd_R424 (ffelexToken access, ffestrOther access_kw, ffelexToken name)
+{
+  ffestd_check_simple_ ();
+
+  ffestd_subr_f90_ ();
+  return;
+
+#ifdef FFESTD_F90
+  char *a;
+
+  if (access == NULL)
+    fprintf (dmpout, "* TYPE %s\n", ffelex_token_text (name));
+  else
+    {
+      switch (access_kw)
+	{
+	case FFESTR_otherPUBLIC:
+	  a = "PUBLIC";
+	  break;
+
+	case FFESTR_otherPRIVATE:
+	  a = "PRIVATE";
+	  break;
+
+	default:
+	  assert (FALSE);
+	}
+      fprintf (dmpout, "* TYPE,%s: %s\n", a, ffelex_token_text (name));
+    }
+#endif
+}
+
+/* ffestd_R425 -- End a TYPE
+
+   ffestd_R425(TRUE);  */
+
+void
+ffestd_R425 (bool ok)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "* END_TYPE %s\n", ffelex_token_text (ffestw_name (ffestw_stack_top ())));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R519_start -- INTENT statement list begin
+
+   ffestd_R519_start();
+
+   Verify that INTENT is valid here, and begin accepting items in the list.  */
+
+void
+ffestd_R519_start (ffestrOther intent_kw)
+{
+  ffestd_check_start_ ();
+
+  ffestd_subr_f90_ ();
+  return;
+
+#ifdef FFESTD_F90
+  char *a;
+
+  switch (intent_kw)
+    {
+    case FFESTR_otherIN:
+      a = "IN";
+      break;
+
+    case FFESTR_otherOUT:
+      a = "OUT";
+      break;
+
+    case FFESTR_otherINOUT:
+      a = "INOUT";
+      break;
+
+    default:
+      assert (FALSE);
+    }
+  fprintf (dmpout, "* INTENT (%s) ", a);
+#endif
+}
+
+/* ffestd_R519_item -- INTENT statement for name
+
+   ffestd_R519_item(name_token);
+
+   Make sure name_token identifies a valid object to be INTENTed.  */
+
+void
+ffestd_R519_item (ffelexToken name)
+{
+  ffestd_check_item_ ();
+
+  return;			/* F90. */
+
+#ifdef FFESTD_F90
+  fprintf (dmpout, "%s,", ffelex_token_text (name));
+#endif
+}
+
+/* ffestd_R519_finish -- INTENT statement list complete
+
+   ffestd_R519_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_R519_finish ()
+{
+  ffestd_check_finish_ ();
+
+  return;			/* F90. */
+
+#ifdef FFESTD_F90
+  fputc ('\n', dmpout);
+#endif
+}
+
+/* ffestd_R520_start -- OPTIONAL statement list begin
+
+   ffestd_R520_start();
+
+   Verify that OPTIONAL is valid here, and begin accepting items in the list.  */
+
+void
+ffestd_R520_start ()
+{
+  ffestd_check_start_ ();
+
+  ffestd_subr_f90_ ();
+  return;
+
+#ifdef FFESTD_F90
+  fputs ("* OPTIONAL ", dmpout);
+#endif
+}
+
+/* ffestd_R520_item -- OPTIONAL statement for name
+
+   ffestd_R520_item(name_token);
+
+   Make sure name_token identifies a valid object to be OPTIONALed.  */
+
+void
+ffestd_R520_item (ffelexToken name)
+{
+  ffestd_check_item_ ();
+
+  return;			/* F90. */
+
+#ifdef FFESTD_F90
+  fprintf (dmpout, "%s,", ffelex_token_text (name));
+#endif
+}
+
+/* ffestd_R520_finish -- OPTIONAL statement list complete
+
+   ffestd_R520_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_R520_finish ()
+{
+  ffestd_check_finish_ ();
+
+  return;			/* F90. */
+
+#ifdef FFESTD_F90
+  fputc ('\n', dmpout);
+#endif
+}
+
+/* ffestd_R521A -- PUBLIC statement
+
+   ffestd_R521A();
+
+   Verify that PUBLIC is valid here.  */
+
+void
+ffestd_R521A ()
+{
+  ffestd_check_simple_ ();
+
+  ffestd_subr_f90_ ();
+  return;
+
+#ifdef FFESTD_F90
+  fputs ("* PUBLIC\n", dmpout);
+#endif
+}
+
+/* ffestd_R521Astart -- PUBLIC statement list begin
+
+   ffestd_R521Astart();
+
+   Verify that PUBLIC is valid here, and begin accepting items in the list.  */
+
+void
+ffestd_R521Astart ()
+{
+  ffestd_check_start_ ();
+
+  ffestd_subr_f90_ ();
+  return;
+
+#ifdef FFESTD_F90
+  fputs ("* PUBLIC ", dmpout);
+#endif
+}
+
+/* ffestd_R521Aitem -- PUBLIC statement for name
+
+   ffestd_R521Aitem(name_token);
+
+   Make sure name_token identifies a valid object to be PUBLICed.  */
+
+void
+ffestd_R521Aitem (ffelexToken name)
+{
+  ffestd_check_item_ ();
+
+  return;			/* F90. */
+
+#ifdef FFESTD_F90
+  fprintf (dmpout, "%s,", ffelex_token_text (name));
+#endif
+}
+
+/* ffestd_R521Afinish -- PUBLIC statement list complete
+
+   ffestd_R521Afinish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_R521Afinish ()
+{
+  ffestd_check_finish_ ();
+
+  return;			/* F90. */
+
+#ifdef FFESTD_F90
+  fputc ('\n', dmpout);
+#endif
+}
+
+/* ffestd_R521B -- PRIVATE statement
+
+   ffestd_R521B();
+
+   Verify that PRIVATE is valid here (outside a derived-type statement).  */
+
+void
+ffestd_R521B ()
+{
+  ffestd_check_simple_ ();
+
+  ffestd_subr_f90_ ();
+  return;
+
+#ifdef FFESTD_F90
+  fputs ("* PRIVATE_outside_of_R422_derived_type_def\n", dmpout);
+#endif
+}
+
+/* ffestd_R521Bstart -- PRIVATE statement list begin
+
+   ffestd_R521Bstart();
+
+   Verify that PRIVATE is valid here, and begin accepting items in the list.  */
+
+void
+ffestd_R521Bstart ()
+{
+  ffestd_check_start_ ();
+
+  ffestd_subr_f90_ ();
+  return;
+
+#ifdef FFESTD_F90
+  fputs ("* PRIVATE ", dmpout);
+#endif
+}
+
+/* ffestd_R521Bitem -- PRIVATE statement for name
+
+   ffestd_R521Bitem(name_token);
+
+   Make sure name_token identifies a valid object to be PRIVATEed.  */
+
+void
+ffestd_R521Bitem (ffelexToken name)
+{
+  ffestd_check_item_ ();
+
+  return;			/* F90. */
+
+#ifdef FFESTD_F90
+  fprintf (dmpout, "%s,", ffelex_token_text (name));
+#endif
+}
+
+/* ffestd_R521Bfinish -- PRIVATE statement list complete
+
+   ffestd_R521Bfinish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_R521Bfinish ()
+{
+  ffestd_check_finish_ ();
+
+  return;			/* F90. */
+
+#ifdef FFESTD_F90
+  fputc ('\n', dmpout);
+#endif
+}
+
+#endif
+/* ffestd_R522 -- SAVE statement with no list
+
+   ffestd_R522();
+
+   Verify that SAVE is valid here, and flag everything as SAVEd.  */
+
+void
+ffestd_R522 ()
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("* SAVE_all\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R522start -- SAVE statement list begin
+
+   ffestd_R522start();
+
+   Verify that SAVE is valid here, and begin accepting items in the list.  */
+
+void
+ffestd_R522start ()
+{
+  ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("* SAVE ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R522item_object -- SAVE statement for object-name
+
+   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_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "%s,", ffelex_token_text (name));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R522item_cblock -- SAVE statement for common-block-name
+
+   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_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "/%s/,", ffelex_token_text (name));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R522finish -- SAVE statement list complete
+
+   ffestd_R522finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_R522finish ()
+{
+  ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R524_start -- DIMENSION statement list begin
+
+   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_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  if (virtual)
+    fputs ("* VIRTUAL ", dmpout);	/* V028. */
+  else
+    fputs ("* DIMENSION ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R524_item -- DIMENSION statement for object-name
+
+   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_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs (ffelex_token_text (name), dmpout);
+  fputc ('(', dmpout);
+  ffestt_dimlist_dump (dims);
+  fputs ("),", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R524_finish -- DIMENSION statement list complete
+
+   ffestd_R524_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_R524_finish ()
+{
+  ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R525_start -- ALLOCATABLE statement list begin
+
+   ffestd_R525_start();
+
+   Verify that ALLOCATABLE is valid here, and begin accepting items in the
+   list.  */
+
+#if FFESTR_F90
+void
+ffestd_R525_start ()
+{
+  ffestd_check_start_ ();
+
+  ffestd_subr_f90_ ();
+  return;
+
+#ifdef FFESTD_F90
+  fputs ("* ALLOCATABLE ", dmpout);
+#endif
+}
+
+/* ffestd_R525_item -- ALLOCATABLE statement for object-name
+
+   ffestd_R525_item(name_token,dim_list);
+
+   Make sure name_token identifies a valid object to be ALLOCATABLEd.  */
+
+void
+ffestd_R525_item (ffelexToken name, ffesttDimList dims)
+{
+  ffestd_check_item_ ();
+
+  return;			/* F90. */
+
+#ifdef FFESTD_F90
+  fputs (ffelex_token_text (name), dmpout);
+  if (dims != NULL)
+    {
+      fputc ('(', dmpout);
+      ffestt_dimlist_dump (dims);
+      fputc (')', dmpout);
+    }
+  fputc (',', dmpout);
+#endif
+}
+
+/* ffestd_R525_finish -- ALLOCATABLE statement list complete
+
+   ffestd_R525_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_R525_finish ()
+{
+  ffestd_check_finish_ ();
+
+  return;			/* F90. */
+
+#ifdef FFESTD_F90
+  fputc ('\n', dmpout);
+#endif
+}
+
+/* ffestd_R526_start -- POINTER statement list begin
+
+   ffestd_R526_start();
+
+   Verify that POINTER is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestd_R526_start ()
+{
+  ffestd_check_start_ ();
+
+  ffestd_subr_f90_ ();
+  return;
+
+#ifdef FFESTD_F90
+  fputs ("* POINTER ", dmpout);
+#endif
+}
+
+/* ffestd_R526_item -- POINTER statement for object-name
+
+   ffestd_R526_item(name_token,dim_list);
+
+   Make sure name_token identifies a valid object to be POINTERd.  */
+
+void
+ffestd_R526_item (ffelexToken name, ffesttDimList dims)
+{
+  ffestd_check_item_ ();
+
+  return;			/* F90. */
+
+#ifdef FFESTD_F90
+  fputs (ffelex_token_text (name), dmpout);
+  if (dims != NULL)
+    {
+      fputc ('(', dmpout);
+      ffestt_dimlist_dump (dims);
+      fputc (')', dmpout);
+    }
+  fputc (',', dmpout);
+#endif
+}
+
+/* ffestd_R526_finish -- POINTER statement list complete
+
+   ffestd_R526_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_R526_finish ()
+{
+  ffestd_check_finish_ ();
+
+  return;			/* F90. */
+
+#ifdef FFESTD_F90
+  fputc ('\n', dmpout);
+#endif
+}
+
+/* ffestd_R527_start -- TARGET statement list begin
+
+   ffestd_R527_start();
+
+   Verify that TARGET is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestd_R527_start ()
+{
+  ffestd_check_start_ ();
+
+  ffestd_subr_f90_ ();
+  return;
+
+#ifdef FFESTD_F90
+  fputs ("* TARGET ", dmpout);
+#endif
+}
+
+/* ffestd_R527_item -- TARGET statement for object-name
+
+   ffestd_R527_item(name_token,dim_list);
+
+   Make sure name_token identifies a valid object to be TARGETd.  */
+
+void
+ffestd_R527_item (ffelexToken name, ffesttDimList dims)
+{
+  ffestd_check_item_ ();
+
+  return;			/* F90. */
+
+#ifdef FFESTD_F90
+  fputs (ffelex_token_text (name), dmpout);
+  if (dims != NULL)
+    {
+      fputc ('(', dmpout);
+      ffestt_dimlist_dump (dims);
+      fputc (')', dmpout);
+    }
+  fputc (',', dmpout);
+#endif
+}
+
+/* ffestd_R527_finish -- TARGET statement list complete
+
+   ffestd_R527_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_R527_finish ()
+{
+  ffestd_check_finish_ ();
+
+  return;			/* F90. */
+
+#ifdef FFESTD_F90
+  fputc ('\n', dmpout);
+#endif
+}
+
+#endif
+/* ffestd_R537_start -- PARAMETER statement list begin
+
+   ffestd_R537_start();
+
+   Verify that PARAMETER is valid here, and begin accepting items in the list.	*/
+
+void
+ffestd_R537_start ()
+{
+  ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("* PARAMETER (", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R537_item -- PARAMETER statement assignment
+
+   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_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  ffebld_dump (dest);
+  fputc ('=', dmpout);
+  ffebld_dump (source);
+  fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R537_finish -- PARAMETER statement list complete
+
+   ffestd_R537_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_R537_finish ()
+{
+  ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R539 -- IMPLICIT NONE statement
+
+   ffestd_R539();
+
+   Verify that the IMPLICIT NONE statement is ok here and implement.  */
+
+void
+ffestd_R539 ()
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("* IMPLICIT_NONE\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R539start -- IMPLICIT statement
+
+   ffestd_R539start();
+
+   Verify that the IMPLICIT statement is ok here and implement.	 */
+
+void
+ffestd_R539start ()
+{
+  ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("* IMPLICIT ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R539item -- IMPLICIT statement specification (R540)
+
+   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)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  char *a;
+#endif
+
+  ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  switch (type)
+    {
+    case FFESTP_typeINTEGER:
+      a = "INTEGER";
+      break;
+
+    case FFESTP_typeBYTE:
+      a = "BYTE";
+      break;
+
+    case FFESTP_typeWORD:
+      a = "WORD";
+      break;
+
+    case FFESTP_typeREAL:
+      a = "REAL";
+      break;
+
+    case FFESTP_typeCOMPLEX:
+      a = "COMPLEX";
+      break;
+
+    case FFESTP_typeLOGICAL:
+      a = "LOGICAL";
+      break;
+
+    case FFESTP_typeCHARACTER:
+      a = "CHARACTER";
+      break;
+
+    case FFESTP_typeDBLPRCSN:
+      a = "DOUBLE PRECISION";
+      break;
+
+    case FFESTP_typeDBLCMPLX:
+      a = "DOUBLE COMPLEX";
+      break;
+
+#if FFESTR_F90
+    case FFESTP_typeTYPE:
+      a = "TYPE";
+      break;
+#endif
+
+    default:
+      assert (FALSE);
+      a = "?";
+      break;
+    }
+  fprintf (dmpout, "%s(", a);
+  if (kindt != NULL)
+    {
+      fputs ("kind=", dmpout);
+      if (kind == NULL)
+	fputs (ffelex_token_text (kindt), dmpout);
+      else
+	ffebld_dump (kind);
+      if (lent != NULL)
+	fputc (',', dmpout);
+    }
+  if (lent != NULL)
+    {
+      fputs ("len=", dmpout);
+      if (len == NULL)
+	fputs (ffelex_token_text (lent), dmpout);
+      else
+	ffebld_dump (len);
+    }
+  fputs (")(", dmpout);
+  ffestt_implist_dump (letters);
+  fputs ("),", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R539finish -- IMPLICIT statement
+
+   ffestd_R539finish();
+
+   Finish up any local activities.  */
+
+void
+ffestd_R539finish ()
+{
+  ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R542_start -- NAMELIST statement list begin
+
+   ffestd_R542_start();
+
+   Verify that NAMELIST is valid here, and begin accepting items in the list.  */
+
+void
+ffestd_R542_start ()
+{
+  ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("* NAMELIST ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R542_item_nlist -- NAMELIST statement for group-name
+
+   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_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "/%s/", ffelex_token_text (name));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R542_item_nitem -- NAMELIST statement for variable-name
+
+   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_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "%s,", ffelex_token_text (name));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R542_finish -- NAMELIST statement list complete
+
+   ffestd_R542_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_R542_finish ()
+{
+  ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R544_start -- EQUIVALENCE statement list begin
+
+   ffestd_R544_start();
+
+   Verify that EQUIVALENCE is valid here, and begin accepting items in the
+   list.  */
+
+#if 0
+void
+ffestd_R544_start ()
+{
+  ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("* EQUIVALENCE (", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+#endif
+/* ffestd_R544_item -- EQUIVALENCE statement assignment
+
+   ffestd_R544_item(exprlist);
+
+   Make sure the equivalence is valid, then implement it.  */
+
+#if 0
+void
+ffestd_R544_item (ffesttExprList exprlist)
+{
+  ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  ffestt_exprlist_dump (exprlist);
+  fputs ("),", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+#endif
+/* ffestd_R544_finish -- EQUIVALENCE statement list complete
+
+   ffestd_R544_finish();
+
+   Just wrap up any local activities.  */
+
+#if 0
+void
+ffestd_R544_finish ()
+{
+  ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+#endif
+/* 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 ()
+{
+  ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("* COMMON ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R547_item_object -- COMMON statement for object-name
+
+   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_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs (ffelex_token_text (name), dmpout);
+  if (dims != NULL)
+    {
+      fputc ('(', dmpout);
+      ffestt_dimlist_dump (dims);
+      fputc (')', dmpout);
+    }
+  fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R547_item_cblock -- COMMON statement for common-block-name
+
+   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_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  if (name == NULL)
+    fputs ("//,", dmpout);
+  else
+    fprintf (dmpout, "/%s/,", ffelex_token_text (name));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R547_finish -- COMMON statement list complete
+
+   ffestd_R547_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_R547_finish ()
+{
+  ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R620 -- ALLOCATE statement
+
+   ffestd_R620(exprlist,stat,stat_token);
+
+   Make sure the expression list is valid, then implement it.  */
+
+#if FFESTR_F90
+void
+ffestd_R620 (ffesttExprList exprlist, ffebld stat)
+{
+  ffestd_check_simple_ ();
+
+  ffestd_subr_f90_ ();
+  return;
+
+#ifdef FFESTD_F90
+  fputs ("+ ALLOCATE (", dmpout);
+  ffestt_exprlist_dump (exprlist);
+  if (stat != NULL)
+    {
+      fputs (",stat=", dmpout);
+      ffebld_dump (stat);
+    }
+  fputs (")\n", dmpout);
+#endif
+}
+
+/* ffestd_R624 -- NULLIFY statement
+
+   ffestd_R624(pointer_name_list);
+
+   Make sure pointer_name_list identifies valid pointers for a NULLIFY.	 */
+
+void
+ffestd_R624 (ffesttExprList pointers)
+{
+  ffestd_check_simple_ ();
+
+  ffestd_subr_f90_ ();
+  return;
+
+#ifdef FFESTD_F90
+  fputs ("+ NULLIFY (", dmpout);
+  assert (pointers != NULL);
+  ffestt_exprlist_dump (pointers);
+  fputs (")\n", dmpout);
+#endif
+}
+
+/* ffestd_R625 -- DEALLOCATE statement
+
+   ffestd_R625(exprlist,stat,stat_token);
+
+   Make sure the equivalence is valid, then implement it.  */
+
+void
+ffestd_R625 (ffesttExprList exprlist, ffebld stat)
+{
+  ffestd_check_simple_ ();
+
+  ffestd_subr_f90_ ();
+  return;
+
+#ifdef FFESTD_F90
+  fputs ("+ DEALLOCATE (", dmpout);
+  ffestt_exprlist_dump (exprlist);
+  if (stat != NULL)
+    {
+      fputs (",stat=", dmpout);
+      ffebld_dump (stat);
+    }
+  fputs (")\n", dmpout);
+#endif
+}
+
+#endif
+/* ffestd_R737A -- Assignment statement outside of WHERE
+
+   ffestd_R737A(dest_expr,source_expr);	 */
+
+void
+ffestd_R737A (ffebld dest, ffebld source)
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R737A (dest, source);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR737A_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R737A.pool = ffesta_output_pool;
+    stmt->u.R737A.dest = dest;
+    stmt->u.R737A.source = source;
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+}
+
+/* ffestd_R737B -- Assignment statement inside of WHERE
+
+   ffestd_R737B(dest_expr,source_expr);	 */
+
+#if FFESTR_F90
+void
+ffestd_R737B (ffebld dest, ffebld source)
+{
+  ffestd_check_simple_ ();
+
+  return;			/* F90. */
+
+#ifdef FFESTD_F90
+  fputs ("+ let_inside_where ", dmpout);
+  ffebld_dump (dest);
+  fputs ("=", dmpout);
+  ffebld_dump (source);
+  fputc ('\n', dmpout);
+#endif
+}
+
+/* ffestd_R738 -- Pointer assignment statement
+
+   ffestd_R738(dest_expr,source_expr,source_token);
+
+   Make sure the assignment is valid.  */
+
+void
+ffestd_R738 (ffebld dest, ffebld source)
+{
+  ffestd_check_simple_ ();
+
+  ffestd_subr_f90_ ();
+  return;
+
+#ifdef FFESTD_F90
+  fputs ("+ let_pointer ", dmpout);
+  ffebld_dump (dest);
+  fputs ("=>", dmpout);
+  ffebld_dump (source);
+  fputc ('\n', dmpout);
+#endif
+}
+
+/* ffestd_R740 -- WHERE statement
+
+   ffestd_R740(expr,expr_token);
+
+   Make sure statement is valid here; implement.  */
+
+void
+ffestd_R740 (ffebld expr)
+{
+  ffestd_check_simple_ ();
+
+  ffestd_subr_f90_ ();
+  return;
+
+#ifdef FFESTD_F90
+  fputs ("+ WHERE (", dmpout);
+  ffebld_dump (expr);
+  fputs (")\n", dmpout);
+
+  ++ffestd_block_level_;
+  assert (ffestd_block_level_ > 0);
+#endif
+}
+
+/* ffestd_R742 -- WHERE-construct statement
+
+   ffestd_R742(expr,expr_token);
+
+   Make sure statement is valid here; implement.  */
+
+void
+ffestd_R742 (ffebld expr)
+{
+  ffestd_check_simple_ ();
+
+  ffestd_subr_f90_ ();
+  return;
+
+#ifdef FFESTD_F90
+  fputs ("+ WHERE_construct (", dmpout);
+  ffebld_dump (expr);
+  fputs (")\n", dmpout);
+
+  ++ffestd_block_level_;
+  assert (ffestd_block_level_ > 0);
+#endif
+}
+
+/* ffestd_R744 -- ELSE WHERE statement
+
+   ffestd_R744();
+
+   Make sure ffestd_kind_ identifies a WHERE block.
+   Implement the ELSE of the current WHERE block.  */
+
+void
+ffestd_R744 ()
+{
+  ffestd_check_simple_ ();
+
+  return;			/* F90. */
+
+#ifdef FFESTD_F90
+  fputs ("+ ELSE_WHERE\n", dmpout);
+#endif
+}
+
+/* ffestd_R745 -- Implicit END WHERE statement
+
+   ffestd_R745(TRUE);
+
+   Implement the end of the current WHERE "block".  ok==TRUE iff statement
+   following WHERE (substatement) is valid; else, statement is invalid
+   or stack forcibly popped due to ffestd_eof_().  */
+
+void
+ffestd_R745 (bool ok)
+{
+  return;			/* F90. */
+
+#ifdef FFESTD_F90
+  fputs ("+ END_WHERE\n", dmpout);	/* Also see ffestd_R745. */
+
+  --ffestd_block_level_;
+  assert (ffestd_block_level_ >= 0);
+#endif
+}
+
+#endif
+/* ffestd_R803 -- Block IF (IF-THEN) statement
+
+   ffestd_R803(construct_name,expr,expr_token);
+
+   Make sure statement is valid here; implement.  */
+
+void
+ffestd_R803 (ffelexToken construct_name UNUSED, ffebld expr)
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R803 (expr);		/* Don't bother with name. */
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR803_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R803.pool = ffesta_output_pool;
+    stmt->u.R803.expr = expr;
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+
+  ++ffestd_block_level_;
+  assert (ffestd_block_level_ > 0);
+}
+
+/* ffestd_R804 -- ELSE IF statement
+
+   ffestd_R804(expr,expr_token,name_token);
+
+   Make sure ffestd_kind_ identifies an IF block.  If not
+   NULL, make sure name_token gives the correct name.  Implement the else
+   of the IF block.  */
+
+void
+ffestd_R804 (ffebld expr, ffelexToken name UNUSED)
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R804 (expr);		/* Don't bother with name. */
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR804_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R804.pool = ffesta_output_pool;
+    stmt->u.R804.expr = expr;
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+}
+
+/* ffestd_R805 -- ELSE statement
+
+   ffestd_R805(name_token);
+
+   Make sure ffestd_kind_ identifies an IF block.  If not
+   NULL, make sure name_token gives the correct name.  Implement the ELSE
+   of the IF block.  */
+
+void
+ffestd_R805 (ffelexToken name UNUSED)
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R805 ();		/* Don't bother with name. */
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR805_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+  }
+#endif
+}
+
+/* ffestd_R806 -- End an IF-THEN
+
+   ffestd_R806(TRUE);  */
+
+void
+ffestd_R806 (bool ok UNUSED)
+{
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R806 ();
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR806_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+  }
+#endif
+
+  --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)
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R807 (expr);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR807_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R807.pool = ffesta_output_pool;
+    stmt->u.R807.expr = expr;
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+
+  ++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)
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R809 (ffestw_stack_top (), expr);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR809_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R809.pool = ffesta_output_pool;
+    stmt->u.R809.block = ffestw_use (ffestw_stack_top ());
+    stmt->u.R809.expr = expr;
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+    malloc_pool_use (ffestw_select (ffestw_stack_top ())->pool);
+  }
+#endif
+
+  ++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)
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R810 (ffestw_stack_top (), casenum);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR810_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R810.pool = ffesta_output_pool;
+    stmt->u.R810.block = ffestw_stack_top ();
+    stmt->u.R810.casenum = casenum;
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+}
+
+/* ffestd_R811 -- End a SELECT
+
+   ffestd_R811(TRUE);  */
+
+void
+ffestd_R811 (bool ok UNUSED)
+{
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R811 (ffestw_stack_top ());
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR811_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R811.block = ffestw_stack_top ();
+  }
+#endif
+
+  --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)
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R819A (ffestw_stack_top (), label, var, start, end, incr,
+		incr_token);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR819A_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R819A.pool = ffesta_output_pool;
+    stmt->u.R819A.block = ffestw_use (ffestw_stack_top ());
+    stmt->u.R819A.label = label;
+    stmt->u.R819A.var = var;
+    stmt->u.R819A.start = start;
+    stmt->u.R819A.start_token = ffelex_token_use (start_token);
+    stmt->u.R819A.end = end;
+    stmt->u.R819A.end_token = ffelex_token_use (end_token);
+    stmt->u.R819A.incr = incr;
+    stmt->u.R819A.incr_token = (incr_token == NULL) ? NULL
+      : ffelex_token_use (incr_token);
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+
+  ++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)
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R819B (ffestw_stack_top (), label, expr);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR819B_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R819B.pool = ffesta_output_pool;
+    stmt->u.R819B.block = ffestw_use (ffestw_stack_top ());
+    stmt->u.R819B.label = label;
+    stmt->u.R819B.expr = expr;
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+
+  ++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)
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R825 ();
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR825_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+  }
+#endif
+}
+
+/* ffestd_R834 -- CYCLE statement
+
+   ffestd_R834(name_token);
+
+   Handle a CYCLE within a loop.  */
+
+void
+ffestd_R834 (ffestw block)
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R834 (block);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR834_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R834.block = block;
+  }
+#endif
+}
+
+/* ffestd_R835 -- EXIT statement
+
+   ffestd_R835(name_token);
+
+   Handle a EXIT within a loop.	 */
+
+void
+ffestd_R835 (ffestw block)
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R835 (block);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR835_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R835.block = block;
+  }
+#endif
+}
+
+/* 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)
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R836 (label);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR836_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R836.label = label;
+  }
+#endif
+
+  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)
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R837 (labels, count, expr);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR837_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R837.pool = ffesta_output_pool;
+    stmt->u.R837.labels = labels;
+    stmt->u.R837.count = count;
+    stmt->u.R837.expr = expr;
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+}
+
+/* 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)
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R838 (label, target);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR838_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R838.pool = ffesta_output_pool;
+    stmt->u.R838.label = label;
+    stmt->u.R838.target = target;
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+}
+
+/* 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)
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R839 (target);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR839_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R839.pool = ffesta_output_pool;
+    stmt->u.R839.target = target;
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+
+  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)
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R840 (expr, neg, zero, pos);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR840_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R840.pool = ffesta_output_pool;
+    stmt->u.R840.expr = expr;
+    stmt->u.R840.neg = neg;
+    stmt->u.R840.zero = zero;
+    stmt->u.R840.pos = pos;
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+
+  if (ffestd_block_level_ == 0)
+    ffestd_is_reachable_ = FALSE;
+}
+
+/* ffestd_R841 -- CONTINUE statement
+
+   ffestd_R841();  */
+
+void
+ffestd_R841 (bool in_where UNUSED)
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R841 ();
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR841_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+  }
+#endif
+}
+
+/* ffestd_R842 -- STOP statement
+
+   ffestd_R842(expr);  */
+
+void
+ffestd_R842 (ffebld expr)
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R842 (expr);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR842_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R842.pool = ffesta_output_pool;
+    stmt->u.R842.expr = expr;
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+
+  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)
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R843 (expr);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR843_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R843.pool = ffesta_output_pool;
+    stmt->u.R843.expr = expr;
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+}
+
+/* ffestd_R904 -- OPEN statement
+
+   ffestd_R904();
+
+   Make sure an OPEN is valid in the current context, and implement it.	 */
+
+void
+ffestd_R904 ()
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#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
+#endif
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R904 (&ffestp_file.open);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR904_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R904.pool = ffesta_output_pool;
+    stmt->u.R904.params = ffestd_subr_copy_open_ ();
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+}
+
+/* ffestd_R907 -- CLOSE statement
+
+   ffestd_R907();
+
+   Make sure a CLOSE is valid in the current context, and implement it.	 */
+
+void
+ffestd_R907 ()
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R907 (&ffestp_file.close);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR907_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R907.pool = ffesta_output_pool;
+    stmt->u.R907.params = ffestd_subr_copy_close_ ();
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+}
+
+/* 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)
+{
+  ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#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
+#endif
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R909_start (&ffestp_file.read, only_format, unit, format, rec, key);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR909_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R909.pool = ffesta_output_pool;
+    stmt->u.R909.params = ffestd_subr_copy_read_ ();
+    stmt->u.R909.only_format = only_format;
+    stmt->u.R909.unit = unit;
+    stmt->u.R909.format = format;
+    stmt->u.R909.rec = rec;
+    stmt->u.R909.key = key;
+    stmt->u.R909.list = NULL;
+    ffestd_expr_list_ = &stmt->u.R909.list;
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+}
+
+/* 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)
+{
+  ffestd_check_item_ ();
+
+#if FFECOM_ONEPASS
+  ffeste_R909_item (expr);
+#else
+  {
+    ffestdExprItem_ item
+    = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
+				       sizeof (*item));
+
+    item->next = NULL;
+    item->expr = expr;
+    item->token = ffelex_token_use (expr_token);
+    *ffestd_expr_list_ = item;
+    ffestd_expr_list_ = &item->next;
+  }
+#endif
+}
+
+/* ffestd_R909_finish -- READ statement list complete
+
+   ffestd_R909_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_R909_finish ()
+{
+  ffestd_check_finish_ ();
+
+#if FFECOM_ONEPASS
+  ffeste_R909_finish ();
+#else
+  /* Nothing to do, it's implicit. */
+#endif
+}
+
+/* ffestd_R910_start -- WRITE(...) statement list begin
+
+   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)
+{
+  ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#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
+#endif
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R910_start (&ffestp_file.write, unit, format, rec);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR910_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R910.pool = ffesta_output_pool;
+    stmt->u.R910.params = ffestd_subr_copy_write_ ();
+    stmt->u.R910.unit = unit;
+    stmt->u.R910.format = format;
+    stmt->u.R910.rec = rec;
+    stmt->u.R910.list = NULL;
+    ffestd_expr_list_ = &stmt->u.R910.list;
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+}
+
+/* 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)
+{
+  ffestd_check_item_ ();
+
+#if FFECOM_ONEPASS
+  ffeste_R910_item (expr);
+#else
+  {
+    ffestdExprItem_ item
+    = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
+				       sizeof (*item));
+
+    item->next = NULL;
+    item->expr = expr;
+    item->token = ffelex_token_use (expr_token);
+    *ffestd_expr_list_ = item;
+    ffestd_expr_list_ = &item->next;
+  }
+#endif
+}
+
+/* ffestd_R910_finish -- WRITE statement list complete
+
+   ffestd_R910_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_R910_finish ()
+{
+  ffestd_check_finish_ ();
+
+#if FFECOM_ONEPASS
+  ffeste_R910_finish ();
+#else
+  /* Nothing to do, it's implicit. */
+#endif
+}
+
+/* ffestd_R911_start -- PRINT statement list begin
+
+   ffestd_R911_start();
+
+   Verify that PRINT is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestd_R911_start (ffestvFormat format)
+{
+  ffestd_check_start_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R911_start (&ffestp_file.print, format);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR911_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R911.pool = ffesta_output_pool;
+    stmt->u.R911.params = ffestd_subr_copy_print_ ();
+    stmt->u.R911.format = format;
+    stmt->u.R911.list = NULL;
+    ffestd_expr_list_ = &stmt->u.R911.list;
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+}
+
+/* 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)
+{
+  ffestd_check_item_ ();
+
+#if FFECOM_ONEPASS
+  ffeste_R911_item (expr);
+#else
+  {
+    ffestdExprItem_ item
+    = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
+				       sizeof (*item));
+
+    item->next = NULL;
+    item->expr = expr;
+    item->token = ffelex_token_use (expr_token);
+    *ffestd_expr_list_ = item;
+    ffestd_expr_list_ = &item->next;
+  }
+#endif
+}
+
+/* ffestd_R911_finish -- PRINT statement list complete
+
+   ffestd_R911_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_R911_finish ()
+{
+  ffestd_check_finish_ ();
+
+#if FFECOM_ONEPASS
+  ffeste_R911_finish ();
+#else
+  /* Nothing to do, it's implicit. */
+#endif
+}
+
+/* ffestd_R919 -- BACKSPACE statement
+
+   ffestd_R919();
+
+   Make sure a BACKSPACE is valid in the current context, and implement it.  */
+
+void
+ffestd_R919 ()
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R919 (&ffestp_file.beru);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR919_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R919.pool = ffesta_output_pool;
+    stmt->u.R919.params = ffestd_subr_copy_beru_ ();
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+}
+
+/* ffestd_R920 -- ENDFILE statement
+
+   ffestd_R920();
+
+   Make sure a ENDFILE is valid in the current context, and implement it.  */
+
+void
+ffestd_R920 ()
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R920 (&ffestp_file.beru);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR920_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R920.pool = ffesta_output_pool;
+    stmt->u.R920.params = ffestd_subr_copy_beru_ ();
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+}
+
+/* ffestd_R921 -- REWIND statement
+
+   ffestd_R921();
+
+   Make sure a REWIND is valid in the current context, and implement it.  */
+
+void
+ffestd_R921 ()
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R921 (&ffestp_file.beru);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR921_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R921.pool = ffesta_output_pool;
+    stmt->u.R921.params = ffestd_subr_copy_beru_ ();
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+}
+
+/* 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)
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#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
+#endif
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R923A (&ffestp_file.inquire, by_file);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR923A_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R923A.pool = ffesta_output_pool;
+    stmt->u.R923A.params = ffestd_subr_copy_inquire_ ();
+    stmt->u.R923A.by_file = by_file;
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+}
+
+/* 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 ()
+{
+  ffestd_check_start_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R923B_start (&ffestp_file.inquire);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR923B_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R923B.pool = ffesta_output_pool;
+    stmt->u.R923B.params = ffestd_subr_copy_inquire_ ();
+    stmt->u.R923B.list = NULL;
+    ffestd_expr_list_ = &stmt->u.R923B.list;
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+}
+
+/* ffestd_R923B_item -- INQUIRE statement i/o item
+
+   ffestd_R923B_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffestd_R923B_item (ffebld expr)
+{
+  ffestd_check_item_ ();
+
+#if FFECOM_ONEPASS
+  ffeste_R923B_item (expr);
+#else
+  {
+    ffestdExprItem_ item
+    = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
+				       sizeof (*item));
+
+    item->next = NULL;
+    item->expr = expr;
+    *ffestd_expr_list_ = item;
+    ffestd_expr_list_ = &item->next;
+  }
+#endif
+}
+
+/* ffestd_R923B_finish -- INQUIRE statement list complete
+
+   ffestd_R923B_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_R923B_finish ()
+{
+  ffestd_check_finish_ ();
+
+#if FFECOM_ONEPASS
+  ffeste_R923B_finish ();
+#else
+  /* Nothing to do, it's implicit. */
+#endif
+}
+
+/* ffestd_R1001 -- FORMAT statement
+
+   ffestd_R1001(format_list);  */
+
+void
+ffestd_R1001 (ffesttFormatList f)
+{
+  ffestsHolder str;
+  ffests s = &str;
+
+  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, ')');
+
+#if FFECOM_ONEPASS
+  ffeste_R1001 (s);
+  ffests_kill (s);		/* Kill the string in s. */
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR1001_);
+    ffestd_stmt_append_ (stmt);
+    stmt->u.R1001.str = str;
+  }
+#endif
+
+  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:
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+	  ffestd_R1001dump_1005_3_ (s, next, "B");
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+	  ffestd_R1001error_ (next);
+#else
+#error
+#endif
+	  break;
+
+	case FFESTP_formattypeO:
+	  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:
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+	  ffestd_R1001dump_1005_5_ (s, next, "EN");
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+	  ffestd_R1001error_ (next);
+#else
+#error
+#endif
+	  break;
+
+	case FFESTP_formattypeG:
+	  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:
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+	  ffestd_R1001dump_1010_1_ (s, next, "Q");
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+	  ffestd_R1001error_ (next);
+#else
+#error
+#endif
+	  break;
+
+	case FFESTP_formattypeDOLLAR:
+	  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_3_ (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_1U (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_R1001error_ (next);
+	    else
+	      ffests_printf_1U (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, 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_R1001error_ (f);
+    else
+      ffests_printf_1U (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_R1001error_ (f);
+    else
+      ffests_printf_1U (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, 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_R1001error_ (f);
+    else
+      ffests_printf_1U (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
+
+  ffests_puts (s, string);
+
+  if (f->u.R1005.R1006.rtexpr)
+    ffestd_R1001error_ (f);
+  else
+    ffests_printf_1U (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, 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_R1001error_ (f);
+    else
+      ffests_printf_1U (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
+
+  ffests_puts (s, string);
+
+  if (f->u.R1005.R1006.rtexpr)
+    ffestd_R1001error_ (f);
+  else
+    ffests_printf_1U (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_R1001error_ (f);
+      else
+	ffests_printf_1U (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, 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_R1001error_ (f);
+    else
+      ffests_printf_1U (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
+
+  ffests_puts (s, string);
+
+  if (f->u.R1005.R1006.rtexpr)
+    ffestd_R1001error_ (f);
+  else
+    ffests_printf_1U (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
+
+  ffests_putc (s, '.');
+  if (f->u.R1005.R1007_or_R1008.rtexpr)
+    ffestd_R1001error_ (f);
+  else
+    ffests_printf_1U (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, 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_R1001error_ (f);
+    else
+      ffests_printf_1U (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
+
+  ffests_puts (s, string);
+
+  if (f->u.R1005.R1006.rtexpr)
+    ffestd_R1001error_ (f);
+  else
+    ffests_printf_1U (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
+
+  ffests_putc (s, '.');
+  if (f->u.R1005.R1007_or_R1008.rtexpr)
+    ffestd_R1001error_ (f);
+  else
+    ffests_printf_1U (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_R1001error_ (f);
+      else
+	ffests_printf_1U (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, 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, char *string)
+{
+  if (f->u.R1010.val.present)
+    if (f->u.R1010.val.rtexpr)
+      ffestd_R1001error_ (f);
+    else
+      ffests_printf_1U (s, "%lu", f->u.R1010.val.u.unsigned_val);
+
+  ffests_puts (s, string);
+}
+
+/* ffestd_R1001dump_1010_3_ -- Dump a particular format
+
+   ffesttFormatList f;
+   ffestd_R1001dump_1010_3_(f,"I");
+
+   The format is dumped with form nX.  */
+
+static void
+ffestd_R1001dump_1010_3_ (ffests s, ffesttFormatList f, char *string)
+{
+  assert (f->u.R1010.val.present);
+
+  if (f->u.R1010.val.rtexpr)
+    ffestd_R1001error_ (f);
+  else
+    ffests_printf_1U (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, char *string)
+{
+  assert (f->u.R1010.val.present);
+
+  if (f->u.R1010.val.rtexpr)
+    ffestd_R1001error_ (f);
+  else
+    ffests_printf_1D (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, char *string)
+{
+  assert (f->u.R1010.val.present);
+
+  ffests_puts (s, string);
+
+  if (f->u.R1010.val.rtexpr)
+    ffestd_R1001error_ (f);
+  else
+    ffests_printf_1U (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 ();
+}
+
+/* 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);
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  if (name == NULL)
+    fputs ("< PROGRAM_unnamed\n", dmpout);
+  else
+    fprintf (dmpout, "< PROGRAM %s\n", ffelex_token_text (name));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R1103 -- End a PROGRAM
+
+   ffestd_R1103();  */
+
+void
+ffestd_R1103 (bool ok UNUSED)
+{
+  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. */
+
+#if FFECOM_ONEPASS
+  ffeste_R1103 ();
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR1103_);
+    ffestd_stmt_append_ (stmt);
+  }
+#endif
+}
+
+/* ffestd_R1105 -- MODULE statement
+
+   ffestd_R1105(name_token);
+
+   Make sure ffestd_kind_ identifies an empty block.  Make sure name_token
+   gives a valid name.	Implement the beginning of a module.  */
+
+#if FFESTR_F90
+void
+ffestd_R1105 (ffelexToken name)
+{
+  assert (ffestd_block_level_ == 0);
+
+  ffestd_check_simple_ ();
+
+  ffestd_subr_f90_ ();
+  return;
+
+#ifdef FFESTD_F90
+  fprintf (dmpout, "* MODULE %s\n", ffelex_token_text (name));
+#endif
+}
+
+/* ffestd_R1106 -- End a MODULE
+
+   ffestd_R1106(TRUE);	*/
+
+void
+ffestd_R1106 (bool ok)
+{
+  assert (ffestd_block_level_ == 0);
+
+  /* Generate any wrap-up code here (unlikely in MODULE!). */
+
+  if (ffestw_state (ffestw_stack_top ()) != FFESTV_stateMODULE5)
+    ffestd_subr_labels_ (TRUE);	/* Handle any undefined labels (unlikely). */
+
+  return;			/* F90. */
+
+#ifdef FFESTD_F90
+  fprintf (dmpout, "< END_MODULE %s\n",
+	   ffelex_token_text (ffestw_name (ffestw_stack_top ())));
+#endif
+}
+
+/* ffestd_R1107_start -- USE statement list begin
+
+   ffestd_R1107_start();
+
+   Verify that USE is valid here, and begin accepting items in the list.  */
+
+void
+ffestd_R1107_start (ffelexToken name, bool only)
+{
+  ffestd_check_start_ ();
+
+  ffestd_subr_f90_ ();
+  return;
+
+#ifdef FFESTD_F90
+  fprintf (dmpout, "* USE %s,", ffelex_token_text (name));	/* NB
+								   _shriek_begin_uses_. */
+  if (only)
+    fputs ("only: ", dmpout);
+#endif
+}
+
+/* ffestd_R1107_item -- USE statement for name
+
+   ffestd_R1107_item(local_token,use_token);
+
+   Make sure name_token identifies a valid object to be USEed.	local_token
+   may be NULL if _start_ was called with only==TRUE.  */
+
+void
+ffestd_R1107_item (ffelexToken local, ffelexToken use)
+{
+  ffestd_check_item_ ();
+  assert (use != NULL);
+
+  return;			/* F90. */
+
+#ifdef FFESTD_F90
+  if (local != NULL)
+    fprintf (dmpout, "%s=>", ffelex_token_text (local));
+  fprintf (dmpout, "%s,", ffelex_token_text (use));
+#endif
+}
+
+/* ffestd_R1107_finish -- USE statement list complete
+
+   ffestd_R1107_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_R1107_finish ()
+{
+  ffestd_check_finish_ ();
+
+  return;			/* F90. */
+
+#ifdef FFESTD_F90
+  fputc ('\n', dmpout);
+#endif
+}
+
+#endif
+/* ffestd_R1111 -- BLOCK DATA statement
+
+   ffestd_R1111(name_token);
+
+   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);
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  if (name == NULL)
+    fputs ("< BLOCK_DATA_unnamed\n", dmpout);
+  else
+    fprintf (dmpout, "< BLOCK_DATA %s\n", ffelex_token_text (name));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R1112 -- End a BLOCK DATA
+
+   ffestd_R1112(TRUE);	*/
+
+void
+ffestd_R1112 (bool ok UNUSED)
+{
+  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. */
+
+#if FFECOM_ONEPASS
+  ffeste_R1112 ();
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR1112_);
+    ffestd_stmt_append_ (stmt);
+  }
+#endif
+}
+
+/* ffestd_R1202 -- INTERFACE statement
+
+   ffestd_R1202(operator,defined_name);
+
+   Make sure ffestd_kind_ identifies an INTERFACE block.
+   Implement the end of the current interface.
+
+   06-Jun-90  JCB  1.1
+      Allow no operator or name to mean INTERFACE by itself; missed this
+      valid form when originally doing syntactic analysis code.	 */
+
+#if FFESTR_F90
+void
+ffestd_R1202 (ffestpDefinedOperator operator, ffelexToken name)
+{
+  ffestd_check_simple_ ();
+
+  ffestd_subr_f90_ ();
+  return;
+
+#ifdef FFESTD_F90
+  switch (operator)
+    {
+    case FFESTP_definedoperatorNone:
+      if (name == NULL)
+	fputs ("* INTERFACE_unnamed\n", dmpout);
+      else
+	fprintf (dmpout, "* INTERFACE %s\n", ffelex_token_text (name));
+      break;
+
+    case FFESTP_definedoperatorOPERATOR:
+      fprintf (dmpout, "* INTERFACE_OPERATOR (.%s.)\n", ffelex_token_text (name));
+      break;
+
+    case FFESTP_definedoperatorASSIGNMENT:
+      fputs ("* INTERFACE_ASSIGNMENT (=)\n", dmpout);
+      break;
+
+    case FFESTP_definedoperatorPOWER:
+      fputs ("* INTERFACE_OPERATOR (**)\n", dmpout);
+      break;
+
+    case FFESTP_definedoperatorMULT:
+      fputs ("* INTERFACE_OPERATOR (*)\n", dmpout);
+      break;
+
+    case FFESTP_definedoperatorADD:
+      fputs ("* INTERFACE_OPERATOR (+)\n", dmpout);
+      break;
+
+    case FFESTP_definedoperatorCONCAT:
+      fputs ("* INTERFACE_OPERATOR (//)\n", dmpout);
+      break;
+
+    case FFESTP_definedoperatorDIVIDE:
+      fputs ("* INTERFACE_OPERATOR (/)\n", dmpout);
+      break;
+
+    case FFESTP_definedoperatorSUBTRACT:
+      fputs ("* INTERFACE_OPERATOR (-)\n", dmpout);
+      break;
+
+    case FFESTP_definedoperatorNOT:
+      fputs ("* INTERFACE_OPERATOR (.not.)\n", dmpout);
+      break;
+
+    case FFESTP_definedoperatorAND:
+      fputs ("* INTERFACE_OPERATOR (.and.)\n", dmpout);
+      break;
+
+    case FFESTP_definedoperatorOR:
+      fputs ("* INTERFACE_OPERATOR (.or.)\n", dmpout);
+      break;
+
+    case FFESTP_definedoperatorEQV:
+      fputs ("* INTERFACE_OPERATOR (.eqv.)\n", dmpout);
+      break;
+
+    case FFESTP_definedoperatorNEQV:
+      fputs ("* INTERFACE_OPERATOR (.neqv.)\n", dmpout);
+      break;
+
+    case FFESTP_definedoperatorEQ:
+      fputs ("* INTERFACE_OPERATOR (==)\n", dmpout);
+      break;
+
+    case FFESTP_definedoperatorNE:
+      fputs ("* INTERFACE_OPERATOR (/=)\n", dmpout);
+      break;
+
+    case FFESTP_definedoperatorLT:
+      fputs ("* INTERFACE_OPERATOR (<)\n", dmpout);
+      break;
+
+    case FFESTP_definedoperatorLE:
+      fputs ("* INTERFACE_OPERATOR (<=)\n", dmpout);
+      break;
+
+    case FFESTP_definedoperatorGT:
+      fputs ("* INTERFACE_OPERATOR (>)\n", dmpout);
+      break;
+
+    case FFESTP_definedoperatorGE:
+      fputs ("* INTERFACE_OPERATOR (>=)\n", dmpout);
+      break;
+
+    default:
+      assert (FALSE);
+      break;
+    }
+#endif
+}
+
+/* ffestd_R1203 -- End an INTERFACE
+
+   ffestd_R1203(TRUE);	*/
+
+void
+ffestd_R1203 (bool ok)
+{
+  return;			/* F90. */
+
+#ifdef FFESTD_F90
+  fputs ("* END_INTERFACE\n", dmpout);
+#endif
+}
+
+/* ffestd_R1205_start -- MODULE PROCEDURE statement list begin
+
+   ffestd_R1205_start();
+
+   Verify that MODULE PROCEDURE is valid here, and begin accepting items in
+   the list.  */
+
+void
+ffestd_R1205_start ()
+{
+  ffestd_check_start_ ();
+
+  return;			/* F90. */
+
+#ifdef FFESTD_F90
+  fputs ("* MODULE_PROCEDURE ", dmpout);
+#endif
+}
+
+/* ffestd_R1205_item -- MODULE PROCEDURE statement for name
+
+   ffestd_R1205_item(name_token);
+
+   Make sure name_token identifies a valid object to be MODULE PROCEDUREed.  */
+
+void
+ffestd_R1205_item (ffelexToken name)
+{
+  ffestd_check_item_ ();
+  assert (name != NULL);
+
+  return;			/* F90. */
+
+#ifdef FFESTD_F90
+  fprintf (dmpout, "%s,", ffelex_token_text (name));
+#endif
+}
+
+/* ffestd_R1205_finish -- MODULE PROCEDURE statement list complete
+
+   ffestd_R1205_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_R1205_finish ()
+{
+  ffestd_check_finish_ ();
+
+  return;			/* F90. */
+
+#ifdef FFESTD_F90
+  fputc ('\n', dmpout);
+#endif
+}
+
+#endif
+/* ffestd_R1207_start -- EXTERNAL statement list begin
+
+   ffestd_R1207_start();
+
+   Verify that EXTERNAL is valid here, and begin accepting items in the list.  */
+
+void
+ffestd_R1207_start ()
+{
+  ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("* EXTERNAL (", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R1207_item -- EXTERNAL statement for name
+
+   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);
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "%s,", ffelex_token_text (name));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R1207_finish -- EXTERNAL statement list complete
+
+   ffestd_R1207_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_R1207_finish ()
+{
+  ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R1208_start -- INTRINSIC statement list begin
+
+   ffestd_R1208_start();
+
+   Verify that INTRINSIC is valid here, and begin accepting items in the list.	*/
+
+void
+ffestd_R1208_start ()
+{
+  ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("* INTRINSIC (", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R1208_item -- INTRINSIC statement for name
+
+   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);
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "%s,", ffelex_token_text (name));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R1208_finish -- INTRINSIC statement list complete
+
+   ffestd_R1208_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_R1208_finish ()
+{
+  ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R1212 -- CALL statement
+
+   ffestd_R1212(expr,expr_token);
+
+   Make sure statement is valid here; implement.  */
+
+void
+ffestd_R1212 (ffebld expr)
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R1212 (expr);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR1212_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R1212.pool = ffesta_output_pool;
+    stmt->u.R1212.expr = expr;
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+}
+
+/* ffestd_R1213 -- Defined assignment statement
+
+   ffestd_R1213(dest_expr,source_expr,source_token);
+
+   Make sure the assignment is valid.  */
+
+#if FFESTR_F90
+void
+ffestd_R1213 (ffebld dest, ffebld source)
+{
+  ffestd_check_simple_ ();
+
+  ffestd_subr_f90_ ();
+  return;
+
+#ifdef FFESTD_F90
+  fputs ("+ let_defined ", dmpout);
+  ffebld_dump (dest);
+  fputs ("=", dmpout);
+  ffebld_dump (source);
+  fputc ('\n', dmpout);
+#endif
+}
+
+#endif
+/* 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)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  char *a;
+#endif
+
+  assert (ffestd_block_level_ == 0);
+  ffestd_is_reachable_ = TRUE;
+
+  ffestd_check_simple_ ();
+
+  ffecom_notify_primary_entry (s);
+  ffestw_set_sym (ffestw_stack_top (), s);
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  switch (type)
+    {
+    case FFESTP_typeINTEGER:
+      a = "INTEGER";
+      break;
+
+    case FFESTP_typeBYTE:
+      a = "BYTE";
+      break;
+
+    case FFESTP_typeWORD:
+      a = "WORD";
+      break;
+
+    case FFESTP_typeREAL:
+      a = "REAL";
+      break;
+
+    case FFESTP_typeCOMPLEX:
+      a = "COMPLEX";
+      break;
+
+    case FFESTP_typeLOGICAL:
+      a = "LOGICAL";
+      break;
+
+    case FFESTP_typeCHARACTER:
+      a = "CHARACTER";
+      break;
+
+    case FFESTP_typeDBLPRCSN:
+      a = "DOUBLE PRECISION";
+      break;
+
+    case FFESTP_typeDBLCMPLX:
+      a = "DOUBLE COMPLEX";
+      break;
+
+#if FFESTR_F90
+    case FFESTP_typeTYPE:
+      a = "TYPE";
+      break;
+#endif
+
+    case FFESTP_typeNone:
+      a = "";
+      break;
+
+    default:
+      assert (FALSE);
+      a = "?";
+      break;
+    }
+  fprintf (dmpout, "< FUNCTION %s ", ffelex_token_text (funcname));
+  if (recursive)
+    fputs ("RECURSIVE ", dmpout);
+  fprintf (dmpout, "%s(", a);
+  if (kindt != NULL)
+    {
+      fputs ("kind=", dmpout);
+      if (kind == NULL)
+	fputs (ffelex_token_text (kindt), dmpout);
+      else
+	ffebld_dump (kind);
+      if (lent != NULL)
+	fputc (',', dmpout);
+    }
+  if (lent != NULL)
+    {
+      fputs ("len=", dmpout);
+      if (len == NULL)
+	fputs (ffelex_token_text (lent), dmpout);
+      else
+	ffebld_dump (len);
+    }
+  fprintf (dmpout, ")");
+  if (args != NULL)
+    {
+      fputs (" (", dmpout);
+      ffestt_tokenlist_dump (args);
+      fputc (')', dmpout);
+    }
+  if (result != NULL)
+    fprintf (dmpout, " result(%s)", ffelex_token_text (result));
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R1221 -- End a FUNCTION
+
+   ffestd_R1221(TRUE);	*/
+
+void
+ffestd_R1221 (bool ok UNUSED)
+{
+  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. */
+
+#if FFECOM_ONEPASS
+  ffeste_R1221 ();
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR1221_);
+    ffestd_stmt_append_ (stmt);
+  }
+#endif
+}
+
+/* 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);
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "< SUBROUTINE %s ", ffelex_token_text (subrname));
+  if (recursive)
+    fputs ("recursive ", dmpout);
+  if (args != NULL)
+    {
+      fputc ('(', dmpout);
+      ffestt_tokenlist_dump (args);
+      fputc (')', dmpout);
+    }
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R1225 -- End a SUBROUTINE
+
+   ffestd_R1225(TRUE);	*/
+
+void
+ffestd_R1225 (bool ok UNUSED)
+{
+  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. */
+
+#if FFECOM_ONEPASS
+  ffeste_R1225 ();
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR1225_);
+    ffestd_stmt_append_ (stmt);
+  }
+#endif
+}
+
+/* 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 (FFECOM_targetCURRENT == FFECOM_targetFFE) || FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R1226 (entry);
+#else
+  if (!ffesta_seen_first_exec || ffecom_2pass_advise_entrypoint (entry))
+    {
+      ffestdStmt_ stmt;
+
+      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_;
+    }
+#endif
+
+  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)
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R1227 (ffestw_stack_top (), expr);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR1227_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.R1227.pool = ffesta_output_pool;
+    stmt->u.R1227.block = ffestw_stack_top ();
+    stmt->u.R1227.expr = expr;
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+
+  if (ffestd_block_level_ == 0)
+    ffestd_is_reachable_ = FALSE;
+}
+
+/* ffestd_R1228 -- CONTAINS statement
+
+   ffestd_R1228();  */
+
+#if FFESTR_F90
+void
+ffestd_R1228 ()
+{
+  assert (ffestd_block_level_ == 0);
+
+  ffestd_check_simple_ ();
+
+  /* Generate RETURN/STOP code here */
+
+  ffestd_subr_labels_ (ffestw_state (ffestw_stack_top ())
+		       == FFESTV_stateMODULE5);	/* Handle any undefined
+						   labels. */
+
+  ffestd_subr_f90_ ();
+  return;
+
+#ifdef FFESTD_F90
+  fputs ("- CONTAINS\n", dmpout);
+#endif
+}
+
+#endif
+/* ffestd_R1229_start -- STMTFUNCTION statement begin
+
+   ffestd_R1229_start(func_name,func_arg_list,close_paren);
+
+   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_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* 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)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  ffebld args = ffesymbol_dummyargs (s);
+#endif
+  ffebld expr = ffesymbol_sfexpr (s);
+
+  ffestd_check_finish_ ();
+
+  if (expr == NULL)
+    return;			/* Nothing to do, definition didn't work. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "* stmtfunction %s(", ffesymbol_text (s));
+  for (; args != NULL; args = ffebld_trail (args))
+    fprintf (dmpout, "%s,", ffesymbol_text (ffebld_symter (ffebld_head (args))));
+  fputs (")=", dmpout);
+  ffebld_dump (expr);
+  fputc ('\n', dmpout);
+#if 0				/* Normally no need to preserve the
+				   expression. */
+  ffesymbol_set_sfexpr (s, NULL);	/* Except expr.c sees NULL
+					   as recursive reference!
+					   So until we can use something
+					   convenient, like a "permanent"
+					   expression, don't worry about
+					   wasting some memory in the
+					   stand-alone FFE. */
+#else
+  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+#endif
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  /* With gcc, cannot do anything here, because the backend hasn't even
+     (necessarily) been notified that we're compiling a program unit! */
+
+#if 0				/* Must preserve the expression for gcc. */
+  ffesymbol_set_sfexpr (s, NULL);
+#else
+  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+#endif
+#else
+#error
+#endif
+}
+
+/* ffestd_S3P4 -- INCLUDE line
+
+   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)
+	ffewhere_file_kill (wf);
+      else
+	ffelex_set_include (wf, (ffelex_token_type (ffesta_tokens[0])
+				 == FFELEX_typeNAME), fi);
+    }
+}
+
+/* ffestd_V003_start -- STRUCTURE statement list begin
+
+   ffestd_V003_start(structure_name);
+
+   Verify that STRUCTURE is valid here, and begin accepting items in the list.	*/
+
+#if FFESTR_VXT
+void
+ffestd_V003_start (ffelexToken structure_name)
+{
+  ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  if (structure_name == NULL)
+    fputs ("* STRUCTURE_unnamed ", dmpout);
+  else
+    fprintf (dmpout, "* STRUCTURE %s ", ffelex_token_text (structure_name));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffestd_subr_vxt_ ();
+#else
+#error
+#endif
+}
+
+/* ffestd_V003_item -- STRUCTURE statement for object-name
+
+   ffestd_V003_item(name_token,dim_list);
+
+   Make sure name_token identifies a valid object to be STRUCTUREd.  */
+
+void
+ffestd_V003_item (ffelexToken name, ffesttDimList dims)
+{
+  ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs (ffelex_token_text (name), dmpout);
+  if (dims != NULL)
+    {
+      fputc ('(', dmpout);
+      ffestt_dimlist_dump (dims);
+      fputc (')', dmpout);
+    }
+  fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_V003_finish -- STRUCTURE statement list complete
+
+   ffestd_V003_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_V003_finish ()
+{
+  ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_V004 -- End a STRUCTURE
+
+   ffestd_V004(TRUE);  */
+
+void
+ffestd_V004 (bool ok)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("* END_STRUCTURE\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_V009 -- UNION statement
+
+   ffestd_V009();  */
+
+void
+ffestd_V009 ()
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("* UNION\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_V010 -- End a UNION
+
+   ffestd_V010(TRUE);  */
+
+void
+ffestd_V010 (bool ok)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("* END_UNION\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_V012 -- MAP statement
+
+   ffestd_V012();  */
+
+void
+ffestd_V012 ()
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("* MAP\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_V013 -- End a MAP
+
+   ffestd_V013(TRUE);  */
+
+void
+ffestd_V013 (bool ok)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("* END_MAP\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+#endif
+/* 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 ()
+{
+  ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("* VOLATILE (", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffestd_subr_vxt_ ();
+#else
+#error
+#endif
+}
+
+/* ffestd_V014_item_object -- VOLATILE statement for object-name
+
+   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_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "%s,", ffelex_token_text (name));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_V014_item_cblock -- VOLATILE statement for common-block-name
+
+   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_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "/%s/,", ffelex_token_text (name));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_V014_finish -- VOLATILE statement list complete
+
+   ffestd_V014_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_V014_finish ()
+{
+  ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_V016_start -- RECORD statement list begin
+
+   ffestd_V016_start();
+
+   Verify that RECORD is valid here, and begin accepting items in the list.  */
+
+#if FFESTR_VXT
+void
+ffestd_V016_start ()
+{
+  ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("* RECORD ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffestd_subr_vxt_ ();
+#else
+#error
+#endif
+}
+
+/* ffestd_V016_item_structure -- RECORD statement for common-block-name
+
+   ffestd_V016_item_structure(name_token);
+
+   Make sure name_token identifies a valid structure to be RECORDed.  */
+
+void
+ffestd_V016_item_structure (ffelexToken name)
+{
+  ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "/%s/,", ffelex_token_text (name));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_V016_item_object -- RECORD statement for object-name
+
+   ffestd_V016_item_object(name_token,dim_list);
+
+   Make sure name_token identifies a valid object to be RECORDd.  */
+
+void
+ffestd_V016_item_object (ffelexToken name, ffesttDimList dims)
+{
+  ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs (ffelex_token_text (name), dmpout);
+  if (dims != NULL)
+    {
+      fputc ('(', dmpout);
+      ffestt_dimlist_dump (dims);
+      fputc (')', dmpout);
+    }
+  fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_V016_finish -- RECORD statement list complete
+
+   ffestd_V016_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_V016_finish ()
+{
+  ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_V018_start -- REWRITE(...) statement list begin
+
+   ffestd_V018_start();
+
+   Verify that REWRITE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestd_V018_start (ffestvFormat format)
+{
+  ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_V018_start (&ffestp_file.rewrite, format);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidV018_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.V018.pool = ffesta_output_pool;
+    stmt->u.V018.params = ffestd_subr_copy_rewrite_ ();
+    stmt->u.V018.format = format;
+    stmt->u.V018.list = NULL;
+    ffestd_expr_list_ = &stmt->u.V018.list;
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffestd_subr_vxt_ ();
+#endif
+}
+
+/* ffestd_V018_item -- REWRITE statement i/o item
+
+   ffestd_V018_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffestd_V018_item (ffebld expr)
+{
+  ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+  ffeste_V018_item (expr);
+#else
+  {
+    ffestdExprItem_ item
+    = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
+				       sizeof (*item));
+
+    item->next = NULL;
+    item->expr = expr;
+    *ffestd_expr_list_ = item;
+    ffestd_expr_list_ = &item->next;
+  }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#endif
+}
+
+/* ffestd_V018_finish -- REWRITE statement list complete
+
+   ffestd_V018_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_V018_finish ()
+{
+  ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+  ffeste_V018_finish ();
+#else
+  /* Nothing to do, it's implicit. */
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#endif
+}
+
+/* ffestd_V019_start -- ACCEPT statement list begin
+
+   ffestd_V019_start();
+
+   Verify that ACCEPT is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestd_V019_start (ffestvFormat format)
+{
+  ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_V019_start (&ffestp_file.accept, format);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidV019_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.V019.pool = ffesta_output_pool;
+    stmt->u.V019.params = ffestd_subr_copy_accept_ ();
+    stmt->u.V019.format = format;
+    stmt->u.V019.list = NULL;
+    ffestd_expr_list_ = &stmt->u.V019.list;
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffestd_subr_vxt_ ();
+#endif
+}
+
+/* ffestd_V019_item -- ACCEPT statement i/o item
+
+   ffestd_V019_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffestd_V019_item (ffebld expr)
+{
+  ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+  ffeste_V019_item (expr);
+#else
+  {
+    ffestdExprItem_ item
+    = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
+				       sizeof (*item));
+
+    item->next = NULL;
+    item->expr = expr;
+    *ffestd_expr_list_ = item;
+    ffestd_expr_list_ = &item->next;
+  }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#endif
+}
+
+/* ffestd_V019_finish -- ACCEPT statement list complete
+
+   ffestd_V019_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_V019_finish ()
+{
+  ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+  ffeste_V019_finish ();
+#else
+  /* Nothing to do, it's implicit. */
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#endif
+}
+
+#endif
+/* 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_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_V020_start (&ffestp_file.type, format);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidV020_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.V020.pool = ffesta_output_pool;
+    stmt->u.V020.params = ffestd_subr_copy_type_ ();
+    stmt->u.V020.format = format;
+    stmt->u.V020.list = NULL;
+    ffestd_expr_list_ = &stmt->u.V020.list;
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffestd_subr_vxt_ ();
+#endif
+}
+
+/* ffestd_V020_item -- TYPE statement i/o item
+
+   ffestd_V020_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffestd_V020_item (ffebld expr UNUSED)
+{
+  ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+  ffeste_V020_item (expr);
+#else
+  {
+    ffestdExprItem_ item
+    = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
+				       sizeof (*item));
+
+    item->next = NULL;
+    item->expr = expr;
+    *ffestd_expr_list_ = item;
+    ffestd_expr_list_ = &item->next;
+  }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#endif
+}
+
+/* ffestd_V020_finish -- TYPE statement list complete
+
+   ffestd_V020_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_V020_finish ()
+{
+  ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+  ffeste_V020_finish ();
+#else
+  /* Nothing to do, it's implicit. */
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#endif
+}
+
+/* ffestd_V021 -- DELETE statement
+
+   ffestd_V021();
+
+   Make sure a DELETE is valid in the current context, and implement it.  */
+
+#if FFESTR_VXT
+void
+ffestd_V021 ()
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_V021 (&ffestp_file.delete);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidV021_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.V021.pool = ffesta_output_pool;
+    stmt->u.V021.params = ffestd_subr_copy_delete_ ();
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffestd_subr_vxt_ ();
+#endif
+}
+
+/* ffestd_V022 -- UNLOCK statement
+
+   ffestd_V022();
+
+   Make sure a UNLOCK is valid in the current context, and implement it.  */
+
+void
+ffestd_V022 ()
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_V022 (&ffestp_file.beru);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidV022_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.V022.pool = ffesta_output_pool;
+    stmt->u.V022.params = ffestd_subr_copy_beru_ ();
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffestd_subr_vxt_ ();
+#endif
+}
+
+/* ffestd_V023_start -- ENCODE(...) statement list begin
+
+   ffestd_V023_start();
+
+   Verify that ENCODE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestd_V023_start ()
+{
+  ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_V023_start (&ffestp_file.vxtcode);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidV023_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.V023.pool = ffesta_output_pool;
+    stmt->u.V023.params = ffestd_subr_copy_vxtcode_ ();
+    stmt->u.V023.list = NULL;
+    ffestd_expr_list_ = &stmt->u.V023.list;
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffestd_subr_vxt_ ();
+#endif
+}
+
+/* ffestd_V023_item -- ENCODE statement i/o item
+
+   ffestd_V023_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffestd_V023_item (ffebld expr)
+{
+  ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+  ffeste_V023_item (expr);
+#else
+  {
+    ffestdExprItem_ item
+    = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
+				       sizeof (*item));
+
+    item->next = NULL;
+    item->expr = expr;
+    *ffestd_expr_list_ = item;
+    ffestd_expr_list_ = &item->next;
+  }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#endif
+}
+
+/* ffestd_V023_finish -- ENCODE statement list complete
+
+   ffestd_V023_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_V023_finish ()
+{
+  ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+  ffeste_V023_finish ();
+#else
+  /* Nothing to do, it's implicit. */
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#endif
+}
+
+/* ffestd_V024_start -- DECODE(...) statement list begin
+
+   ffestd_V024_start();
+
+   Verify that DECODE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestd_V024_start ()
+{
+  ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_V024_start (&ffestp_file.vxtcode);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidV024_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.V024.pool = ffesta_output_pool;
+    stmt->u.V024.params = ffestd_subr_copy_vxtcode_ ();
+    stmt->u.V024.list = NULL;
+    ffestd_expr_list_ = &stmt->u.V024.list;
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffestd_subr_vxt_ ();
+#endif
+}
+
+/* ffestd_V024_item -- DECODE statement i/o item
+
+   ffestd_V024_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffestd_V024_item (ffebld expr)
+{
+  ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+  ffeste_V024_item (expr);
+#else
+  {
+    ffestdExprItem_ item
+    = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
+				       sizeof (*item));
+
+    item->next = NULL;
+    item->expr = expr;
+    *ffestd_expr_list_ = item;
+    ffestd_expr_list_ = &item->next;
+  }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#endif
+}
+
+/* ffestd_V024_finish -- DECODE statement list complete
+
+   ffestd_V024_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_V024_finish ()
+{
+  ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+  ffeste_V024_finish ();
+#else
+  /* Nothing to do, it's implicit. */
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#endif
+}
+
+/* ffestd_V025_start -- DEFINEFILE statement list begin
+
+   ffestd_V025_start();
+
+   Verify that DEFINEFILE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestd_V025_start ()
+{
+  ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_V025_start ();
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidV025start_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffestd_subr_vxt_ ();
+#endif
+}
+
+/* ffestd_V025_item -- DEFINE FILE statement item
+
+   ffestd_V025_item(u,ut,m,mt,n,nt,asv,asvt);
+
+   Implement item.  Treat each item kind of like a separate statement,
+   since there's really no need to treat them as an aggregate.	*/
+
+void
+ffestd_V025_item (ffebld u, ffebld m, ffebld n, ffebld asv)
+{
+  ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+  ffeste_V025_item (u, m, n, asv);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidV025item_);
+    ffestd_stmt_append_ (stmt);
+    stmt->u.V025item.u = u;
+    stmt->u.V025item.m = m;
+    stmt->u.V025item.n = n;
+    stmt->u.V025item.asv = asv;
+  }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#endif
+}
+
+/* ffestd_V025_finish -- DEFINE FILE statement list complete
+
+   ffestd_V025_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_V025_finish ()
+{
+  ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+  ffeste_V025_finish ();
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidV025finish_);
+    stmt->u.V025finish.pool = ffesta_output_pool;
+    ffestd_stmt_append_ (stmt);
+  }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#endif
+}
+
+/* ffestd_V026 -- FIND statement
+
+   ffestd_V026();
+
+   Make sure a FIND is valid in the current context, and implement it.	*/
+
+void
+ffestd_V026 ()
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_V026 (&ffestp_file.find);
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidV026_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+    stmt->u.V026.pool = ffesta_output_pool;
+    stmt->u.V026.params = ffestd_subr_copy_find_ ();
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+  }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffestd_subr_vxt_ ();
+#endif
+}
+
+#endif
+/* 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 ()
+{
+  ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("* PARAMETER_vxt ", dmpout);
+#else
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffestd_subr_vxt_ ();
+#endif
+#endif
+}
+
+/* ffestd_V027_item -- VXT PARAMETER statement assignment
+
+   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_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs (ffelex_token_text (dest_token), dmpout);
+  fputc ('=', dmpout);
+  ffebld_dump (source);
+  fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_V027_finish -- VXT PARAMETER statement list complete
+
+   ffestd_V027_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestd_V027_finish ()
+{
+  ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* Any executable statement.  */
+
+void
+ffestd_any ()
+{
+  ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+  ffestd_subr_line_now_ ();
+  ffeste_R841 ();
+#else
+  {
+    ffestdStmt_ stmt;
+
+    stmt = ffestd_stmt_new_ (FFESTD_stmtidR841_);
+    ffestd_stmt_append_ (stmt);
+    ffestd_subr_line_save_ (stmt);
+  }
+#endif
+}
diff --git a/gcc/f/std.h b/gcc/f/std.h
new file mode 100644
index 00000000000..0e608b13548
--- /dev/null
+++ b/gcc/f/std.h
@@ -0,0 +1,298 @@
+/* std.h -- Private #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_std
+#define _H_f_std
+
+/* 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);
+#if FFESTR_F90
+void ffestd_end_uses (bool ok);
+void ffestd_end_R740 (bool ok);
+#endif
+void ffestd_end_R807 (bool ok);
+void ffestd_exec_begin (void);
+void ffestd_exec_end (void);
+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);
+#if FFESTR_F90
+void ffestd_R423A (void);
+void ffestd_R423B (void);
+void ffestd_R424 (ffelexToken access, ffestrOther access_kw, ffelexToken name);
+void ffestd_R425 (bool ok);
+void ffestd_R519_start (ffestrOther intent_kw);
+void ffestd_R519_item (ffelexToken name);
+void ffestd_R519_finish (void);
+void ffestd_R520_start (void);
+void ffestd_R520_item (ffelexToken name);
+void ffestd_R520_finish (void);
+void ffestd_R521A (void);
+void ffestd_R521Astart (void);
+void ffestd_R521Aitem (ffelexToken name);
+void ffestd_R521Afinish (void);
+void ffestd_R521B (void);
+void ffestd_R521Bstart (void);
+void ffestd_R521Bitem (ffelexToken name);
+void ffestd_R521Bfinish (void);
+#endif
+void ffestd_R522 (void);
+void ffestd_R522start (void);
+void ffestd_R522item_object (ffelexToken name);
+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);
+#if FFESTR_F90
+void ffestd_R525_start (void);
+void ffestd_R525_item (ffelexToken name, ffesttDimList dims);
+void ffestd_R525_finish (void);
+void ffestd_R526_start (void);
+void ffestd_R526_item (ffelexToken name, ffesttDimList dims);
+void ffestd_R526_finish (void);
+void ffestd_R527_start (void);
+void ffestd_R527_item (ffelexToken name, ffesttDimList dims);
+void ffestd_R527_finish (void);
+#endif
+void ffestd_R537_start (void);
+void ffestd_R537_item (ffebld dest, ffebld source);
+void ffestd_R537_finish (void);
+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);
+#if FFESTR_F90
+void ffestd_R620 (ffesttExprList exprlist, ffebld stat);
+void ffestd_R624 (ffesttExprList pointers);
+void ffestd_R625 (ffesttExprList exprlist, ffebld stat);
+#endif
+void ffestd_R737A (ffebld dest, ffebld source);
+#if FFESTR_F90
+void ffestd_R737B (ffebld dest, ffebld source);
+void ffestd_R738 (ffebld dest, ffebld source);
+void ffestd_R740 (ffebld expr);
+void ffestd_R742 (ffebld expr);
+void ffestd_R744 (void);
+void ffestd_R745 (bool ok);
+#endif
+void ffestd_R803 (ffelexToken construct_name, ffebld expr);
+void ffestd_R804 (ffebld expr, ffelexToken name);
+void ffestd_R805 (ffelexToken name);
+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);
+#if FFESTR_F90
+void ffestd_R1105 (ffelexToken name);
+void ffestd_R1106 (bool ok);
+void ffestd_R1107_start (ffelexToken name, bool only);
+void ffestd_R1107_item (ffelexToken local, ffelexToken use);
+void ffestd_R1107_finish (void);
+#endif
+void ffestd_R1111 (ffesymbol s, ffelexToken name);
+void ffestd_R1112 (bool ok);
+#if FFESTR_F90
+void ffestd_R1202 (ffestpDefinedOperator operator, ffelexToken name);
+void ffestd_R1203 (bool ok);
+void ffestd_R1205_start (void);
+void ffestd_R1205_item (ffelexToken name);
+void ffestd_R1205_finish (void);
+#endif
+void ffestd_R1207_start (void);
+void ffestd_R1207_item (ffelexToken name);
+void ffestd_R1207_finish (void);
+void ffestd_R1208_start (void);
+void ffestd_R1208_item (ffelexToken name);
+void ffestd_R1208_finish (void);
+void ffestd_R1212 (ffebld expr);
+#if FFESTR_F90
+void ffestd_R1213 (ffebld dest, ffebld source);
+#endif
+void ffestd_R1219 (ffesymbol s, ffelexToken funcname,
+		   ffesttTokenList args, ffestpType type, ffebld kind,
+		   ffelexToken kindt, ffebld len, ffelexToken lent,
+		   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);
+#if FFESTR_F90
+void ffestd_R1228 (void);
+#endif
+void ffestd_R1229_start (ffelexToken name, ffesttTokenList args);
+void ffestd_R1229_finish (ffesymbol s);
+void ffestd_S3P4 (ffebld filename);
+#if FFESTR_VXT
+void ffestd_V003_start (ffelexToken structure_name);
+void ffestd_V003_item (ffelexToken name, ffesttDimList dims);
+void ffestd_V003_finish (void);
+void ffestd_V004 (bool ok);
+void ffestd_V009 (void);
+void ffestd_V010 (bool ok);
+void ffestd_V012 (void);
+void ffestd_V013 (bool ok);
+#endif
+void ffestd_V014_start (void);
+void ffestd_V014_item_object (ffelexToken name);
+void ffestd_V014_item_cblock (ffelexToken name);
+void ffestd_V014_finish (void);
+#if FFESTR_VXT
+void ffestd_V016_start (void);
+void ffestd_V016_item_structure (ffelexToken name);
+void ffestd_V016_item_object (ffelexToken name, ffesttDimList dims);
+void ffestd_V016_finish (void);
+void ffestd_V018_start (ffestvFormat format);
+void ffestd_V018_item (ffebld expr);
+void ffestd_V018_finish (void);
+void ffestd_V019_start (ffestvFormat format);
+void ffestd_V019_item (ffebld expr);
+void ffestd_V019_finish (void);
+#endif
+void ffestd_V020_start (ffestvFormat format);
+void ffestd_V020_item (ffebld expr);
+void ffestd_V020_finish (void);
+#if FFESTR_VXT
+void ffestd_V021 (void);
+void ffestd_V022 (void);
+void ffestd_V023_start (void);
+void ffestd_V023_item (ffebld expr);
+void ffestd_V023_finish (void);
+void ffestd_V024_start (void);
+void ffestd_V024_item (ffebld expr);
+void ffestd_V024_finish (void);
+void ffestd_V025_start (void);
+void ffestd_V025_item (ffebld u, ffebld m, ffebld n, ffebld asv);
+void ffestd_V025_finish (void);
+void ffestd_V026 (void);
+#endif
+void ffestd_V027_start (void);
+void ffestd_V027_item (ffelexToken dest_token, ffebld source);
+void ffestd_V027_finish (void);
+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
diff --git a/gcc/f/ste.c b/gcc/f/ste.c
new file mode 100644
index 00000000000..a5e9757cca3
--- /dev/null
+++ b/gcc/f/ste.c
@@ -0,0 +1,5414 @@
+/* ste.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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:
+*/
+
+/* As of 0.5.4, any statement that calls on ffecom to transform an
+   expression might need to be wrapped in ffecom_push_calltemps ()
+   and ffecom_pop_calltemps () as are some other cases.  That is
+   the case when the transformation might involve generation of
+   a temporary that must be auto-popped, the specific case being
+   when a COMPLEX operation requiring a call to libf2c being
+   generated, whereby a temp is needed to hold the result since
+   libf2c doesn't return COMPLEX results directly.  Cases where it
+   is known that ffecom_expr () won't need to do this, such as
+   the CALL statement (where it's the transformation of the
+   call expr itself that does the wrapping), don't need to bother
+   with this wrapping.  Forgetting to do the wrapping currently
+   means a crash at an assertion when the wrapping would be helpful
+   to keep temporaries from being wasted -- see ffecom_push_tempvar.  */
+
+/* Include files. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#include "config.j"
+#include "rtl.j"
+#endif
+
+#include "proj.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_;
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static ffelab ffeste_label_formatdef_ = NULL;
+static tree (*ffeste_io_driver_) (ffebld expr);	/* do?io. */
+static ffecomGfrt ffeste_io_endgfrt_;	/* end function to call. */
+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. */
+#endif
+
+/* Static functions (internal). */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void ffeste_begin_iterdo_ (ffestw block, tree *tvar, tree *tincr,
+				  tree *xitersvar, ffebld var,
+				  ffebld start, ffelexToken start_token,
+				  ffebld end, ffelexToken end_token,
+				  ffebld incr, ffelexToken incr_token,
+				  char *msg);
+static void ffeste_end_iterdo_ (tree tvar, tree tincr, tree itersvar);
+static void ffeste_io_call_ (tree call, bool do_check);
+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 void ffeste_io_impdo_ (ffebld impdo, ffelexToken impdo_token);
+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);
+#elif FFECOM_targetCURRENT == FFECOM_targetFFE
+static void ffeste_subr_file_ (char *kw, ffestpFile *spec);
+#else
+#error
+#endif
+
+/* Internal macros. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#define ffeste_emit_line_note_() \
+  emit_line_note (input_filename, lineno)
+#endif
+#define ffeste_check_simple_() \
+  assert(ffeste_statelet_ == FFESTE_stateletSIMPLE_)
+#define ffeste_check_start_() \
+  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_charnolenspec_(Spec,Exp,Init)			    \
+  do									      \
+    {									      \
+    if (Spec->kw_or_val_present)					      \
+	Exp = ffecom_arg_ptr_to_expr(Spec->u.expr,&ignore);		 \
+      else								      \
+	Exp = null_pointer_node;					      \
+    if (TREE_CONSTANT(Exp))						      \
+	{								      \
+	Init = Exp;							      \
+	Exp = NULL_TREE;						      \
+	}								      \
+      else								      \
+	{								      \
+	Init = null_pointer_node;					      \
+	constantp = FALSE;						      \
+	}								      \
+    } while(0)
+
+#define ffeste_f2c_charspec_(Spec,Exp,Init,Lenexp,Leninit)		    \
+  do									      \
+    {									      \
+    if (Spec->kw_or_val_present)					      \
+	Exp = ffecom_arg_ptr_to_expr(Spec->u.expr,&Lenexp);		      \
+      else								      \
+	{								      \
+	Exp = null_pointer_node;					      \
+	Lenexp = ffecom_f2c_ftnlen_zero_node;				      \
+	}								      \
+    if (TREE_CONSTANT(Exp))						      \
+	{								      \
+	Init = Exp;							      \
+	Exp = NULL_TREE;						      \
+	}								      \
+      else								      \
+	{								      \
+	Init = null_pointer_node;					      \
+	constantp = FALSE;						      \
+	}								      \
+    if ((Lenexp != NULL_TREE) && TREE_CONSTANT(Lenexp))			      \
+	{								      \
+	Leninit = Lenexp;						      \
+	Lenexp = NULL_TREE;						      \
+	}								      \
+      else								      \
+	{								      \
+	Leninit = ffecom_f2c_ftnlen_zero_node;				      \
+	constantp = FALSE;						      \
+	}								      \
+    } while(0)
+
+#define ffeste_f2c_exp_(Field,Exp)					      \
+  do									      \
+    {									      \
+    if (Exp != NULL_TREE)						      \
+	{								      \
+	Exp = ffecom_modify(void_type_node,ffecom_2(COMPONENT_REF,	      \
+	      TREE_TYPE(Field),t,Field),Exp);				      \
+	expand_expr_stmt(Exp);						      \
+	}								      \
+    } while(0)
+
+#define ffeste_f2c_init_(Init)						    \
+  do									      \
+    {									      \
+    TREE_CHAIN(initn) = build_tree_list((field = TREE_CHAIN(field)),Init);    \
+    initn = TREE_CHAIN(initn);						      \
+    } while(0)
+
+#define ffeste_f2c_flagspec_(Flag,Init)					      \
+  do { Init = convert (ffecom_f2c_flag_type_node,			      \
+		       Flag ? integer_one_node : integer_zero_node); }	      \
+    while(0)
+
+#define ffeste_f2c_intspec_(Spec,Exp,Init)				      \
+  do									      \
+    {									      \
+    if (Spec->kw_or_val_present)					      \
+	Exp = ffecom_expr(Spec->u.expr);				      \
+      else								      \
+	Exp = ffecom_integer_zero_node;					      \
+    if (TREE_CONSTANT(Exp))						      \
+	{								      \
+	Init = Exp;							      \
+	Exp = NULL_TREE;						      \
+	}								      \
+      else								      \
+	{								      \
+	Init = ffecom_integer_zero_node;				      \
+	constantp = FALSE;						      \
+	}								      \
+    } while(0)
+
+#define ffeste_f2c_ptrtointspec_(Spec,Exp,Init)				    \
+  do									      \
+    {									      \
+    if (Spec->kw_or_val_present)					      \
+	Exp = ffecom_ptr_to_expr(Spec->u.expr);				 \
+      else								      \
+	Exp = null_pointer_node;					      \
+    if (TREE_CONSTANT(Exp))						      \
+	{								      \
+	Init = Exp;							      \
+	Exp = NULL_TREE;						      \
+	}								      \
+      else								      \
+	{								      \
+	Init = null_pointer_node;					      \
+	constantp = FALSE;						      \
+	}								      \
+    } while(0)
+
+
+/* Begin an iterative DO loop.  Pass the block to start if applicable.
+
+   NOTE: Does _two_ push_momentary () calls, which the caller must
+   undo (by calling ffeste_end_iterdo_).  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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,
+		      char *msg)
+{
+  tree tvar;
+  tree expr;
+  tree tstart;
+  tree tend;
+  tree tincr;
+  tree tincr_saved;
+  tree niters;
+
+  push_momentary ();		/* Want to save these throughout the loop. */
+
+  tvar = ffecom_expr_rw (var);
+  tincr = ffecom_expr (incr);
+
+  /* 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);
+
+  push_momentary ();		/* Want to discard the rest after the loop. */
+
+  tstart = ffecom_expr (start);
+  tend = ffecom_expr (end);
+
+  {				/* 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.  */
+
+  expr = ffecom_modify (void_type_node, tvar, tstart);
+  expand_expr_stmt (expr);
+
+  expr = ffecom_2 (MINUS_EXPR, TREE_TYPE (tvar),
+		   tend,
+		   TREE_CONSTANT (tstart) ? tstart : tvar);
+
+  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
+
+  niters = ffecom_push_tempvar (TREE_TYPE (expr),
+				FFETARGET_charactersizeNONE, -1, FALSE);
+  expr = ffecom_modify (void_type_node, niters, expr);
+  expand_expr_stmt (expr);
+
+  if (block == NULL)
+    expand_start_loop_continue_elsewhere (0);
+  else
+    ffestw_set_do_hook (block,
+			expand_start_loop_continue_elsewhere (1));
+
+  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);
+    }
+
+  clear_momentary ();		/* Discard the above now that we're done with
+				   DO stmt. */
+
+  if (block == NULL)
+    {
+      *xtvar = tvar;
+      *xtincr = tincr_saved;
+      *xitersvar = niters;
+    }
+  else
+    {
+      ffestw_set_do_tvar (block, tvar);
+      ffestw_set_do_incr_saved (block, tincr_saved);
+      ffestw_set_do_count_var (block, niters);
+    }
+}
+
+#endif
+
+/* End an iterative DO loop.  Pass the same iteration variable and increment
+   value trees that were generated in the paired _begin_ call.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffeste_end_iterdo_ (tree tvar, tree tincr, tree itersvar)
+{
+  tree expr;
+  tree niters = itersvar;
+
+  expand_loop_continue_here ();
+
+  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);
+  expand_end_loop ();
+
+  ffecom_pop_tempvar (itersvar);	/* Free #iters var. */
+
+  clear_momentary ();
+  pop_momentary ();		/* Lose the stuff we just built. */
+
+  clear_momentary ();
+  pop_momentary ();		/* Lose the tvar and incr_saved trees. */
+}
+
+#endif
+/* ffeste_io_call_ -- Generate call to run-time I/O routine
+
+   tree callexpr = build(CALL_EXPR,...);
+   ffeste_io_call_(callexpr,TRUE);
+
+   Sets TREE_SIDE_EFFECTS(callexpr) = 1.  If ffeste_io_iostat_ is not
+   NULL_TREE, replaces callexpr with "iostat = callexpr;".  Expands the
+   result.  If ffeste_io_abort_ is not NULL_TREE and the second argument
+   is TRUE, generates "if (iostat != 0) goto ffeste_io_abort_;".  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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 ();
+}
+
+#endif
+/* ffeste_io_dofio_ -- Generate call to do_fio for formatted I/O item
+
+   ffebld expr;
+   tree call;
+   call = ffeste_io_dofio_(expr);
+
+   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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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;
+
+  ffecom_push_calltemps ();
+
+  variable = ffecom_arg_ptr_to_expr (expr, &size);
+
+  if ((variable == error_mark_node)
+      || (size == error_mark_node))
+    {
+      ffecom_pop_calltemps ();
+      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 (ffecom_tree_type[bt][kt]),
+			 size_int (TYPE_PRECISION (char_type_node)));
+#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 (TREE_TYPE (TREE_TYPE (variable))), size);
+      num_elements = size_binop (CEIL_DIV_EXPR, num_elements,
+				 size_int (TYPE_PRECISION
+					   (char_type_node)));
+      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);
+
+  ffecom_pop_calltemps ();
+
+  return ffecom_call_gfrt (FFECOM_gfrtDOFIO, arglist);
+}
+
+#endif
+/* ffeste_io_dolio_ -- Generate call to do_lio for list-directed I/O item
+
+   ffebld expr;
+   tree call;
+   call = ffeste_io_dolio_(expr);
+
+   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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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;
+
+  ffecom_push_calltemps ();
+
+  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))
+    {
+      ffecom_pop_calltemps ();
+      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 (ffecom_tree_type[bt][kt]),
+			 size_int (TYPE_PRECISION (char_type_node)));
+#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 (TREE_TYPE (TREE_TYPE (variable))), size);
+      num_elements = size_binop (CEIL_DIV_EXPR,
+				 num_elements, size_int (TYPE_PRECISION
+							 (char_type_node)));
+      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);
+
+  ffecom_pop_calltemps ();
+
+  return ffecom_call_gfrt (FFECOM_gfrtDOLIO, arglist);
+}
+
+#endif
+/* ffeste_io_douio_ -- Generate call to do_uio for unformatted I/O item
+
+   ffebld expr;
+   tree call;
+   call = ffeste_io_douio_(expr);
+
+   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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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;
+
+  ffecom_push_calltemps ();
+
+  variable = ffecom_arg_ptr_to_expr (expr, &size);
+
+  if ((variable == error_mark_node)
+      || (size == error_mark_node))
+    {
+      ffecom_pop_calltemps ();
+      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 (ffecom_tree_type[bt][kt]),
+			 size_int (TYPE_PRECISION (char_type_node)));
+#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 (TREE_TYPE (TREE_TYPE (variable))), size);
+      num_elements = size_binop (CEIL_DIV_EXPR, num_elements,
+				 size_int (TYPE_PRECISION
+					   (char_type_node)));
+      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);
+
+  ffecom_pop_calltemps ();
+
+  return ffecom_call_gfrt (FFECOM_gfrtDOUIO, arglist);
+}
+
+#endif
+/* ffeste_io_ialist_ -- Make arglist with ptr to B/E/R control list
+
+   tree arglist;
+   arglist = ffeste_io_ialist_(...);
+
+   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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffeste_io_ialist_ (bool have_err,
+		   ffestvUnit unit,
+		   ffebld unit_expr,
+		   int unit_dflt)
+{
+  static tree f2c_alist_struct = NULL_TREE;
+  tree t;
+  tree ttype;
+  int yes;
+  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;
+
+      push_obstacks_nochange ();
+      end_temporary_allocation ();
+
+      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);
+
+      resume_temporary_allocation ();
+      pop_obstacks ();
+
+      f2c_alist_struct = ref;
+    }
+
+  ffeste_f2c_flagspec_ (have_err, errinit);
+
+  switch (unit)
+    {
+    case FFESTV_unitNONE:
+    case FFESTV_unitASTERISK:
+      unitinit = build_int_2 (unit_dflt, 0);
+      unitexp = NULL_TREE;
+      break;
+
+    case FFESTV_unitINTEXPR:
+      unitexp = ffecom_expr (unit_expr);
+      if (TREE_CONSTANT (unitexp))
+	{
+	  unitinit = unitexp;
+	  unitexp = NULL_TREE;
+	}
+      else
+	{
+	  unitinit = ffecom_integer_zero_node;
+	  constantp = FALSE;
+	}
+      break;
+
+    default:
+      assert ("bad unit spec" == NULL);
+      unitexp = NULL_TREE;
+      unitinit = ffecom_integer_zero_node;
+      break;
+    }
+
+  inits = build_tree_list ((field = TYPE_FIELDS (f2c_alist_struct)), errinit);
+  initn = inits;
+  ffeste_f2c_init_ (unitinit);
+
+  inits = build (CONSTRUCTOR, f2c_alist_struct, NULL_TREE, inits);
+  TREE_CONSTANT (inits) = constantp ? 1 : 0;
+  TREE_STATIC (inits) = 1;
+
+  yes = suspend_momentary ();
+
+  t = build_decl (VAR_DECL,
+		  ffecom_get_invented_identifier ("__g77_alist_%d", NULL,
+						  mynumber++),
+		  f2c_alist_struct);
+  TREE_STATIC (t) = 1;
+  t = ffecom_start_decl (t, 1);
+  ffecom_finish_decl (t, inits, 0);
+
+  resume_momentary (yes);
+
+  ffeste_f2c_exp_ (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;
+}
+
+#endif
+/* ffeste_io_cilist_ -- Make arglist with ptr to external I/O control list
+
+   tree arglist;
+   arglist = ffeste_io_cilist_(...);
+
+   Returns a tree suitable as an argument list containing a pointer to
+   an external-file 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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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 f2c_cilist_struct = NULL_TREE;
+  tree t;
+  tree ttype;
+  int yes;
+  tree field;
+  tree inits, initn;
+  tree ignore;			/* We ignore the length of format! */
+  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;
+
+      push_obstacks_nochange ();
+      end_temporary_allocation ();
+
+      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);
+
+      resume_temporary_allocation ();
+      pop_obstacks ();
+
+      f2c_cilist_struct = ref;
+    }
+
+  ffeste_f2c_flagspec_ (have_err, errinit);
+
+  switch (unit)
+    {
+    case FFESTV_unitNONE:
+    case FFESTV_unitASTERISK:
+      unitinit = build_int_2 (unit_dflt, 0);
+      unitexp = NULL_TREE;
+      break;
+
+    case FFESTV_unitINTEXPR:
+      unitexp = ffecom_expr (unit_expr);
+      if (TREE_CONSTANT (unitexp))
+	{
+	  unitinit = unitexp;
+	  unitexp = NULL_TREE;
+	}
+      else
+	{
+	  unitinit = ffecom_integer_zero_node;
+	  constantp = FALSE;
+	}
+      break;
+
+    default:
+      assert ("bad unit spec" == NULL);
+      unitexp = NULL_TREE;
+      unitinit = ffecom_integer_zero_node;
+      break;
+    }
+
+  switch (format)
+    {
+    case FFESTV_formatNONE:
+      formatinit = null_pointer_node;
+      formatexp = NULL_TREE;
+      break;
+
+    case FFESTV_formatLABEL:
+      formatexp = NULL_TREE;
+      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_expr (format_spec->u.expr, &ignore);
+      if (TREE_CONSTANT (formatexp))
+	{
+	  formatinit = formatexp;
+	  formatexp = NULL_TREE;
+	}
+      else
+	{
+	  formatinit = null_pointer_node;
+	  constantp = FALSE;
+	}
+      break;
+
+    case FFESTV_formatASTERISK:
+      formatinit = null_pointer_node;
+      formatexp = NULL_TREE;
+      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 = NULL_TREE;
+      break;
+
+    default:
+      assert ("bad format spec" == NULL);
+      formatexp = NULL_TREE;
+      formatinit = integer_zero_node;
+      break;
+    }
+
+  ffeste_f2c_flagspec_ (have_end, endinit);
+
+  if (rec)
+    recexp = ffecom_expr (rec_expr);
+  else
+    recexp = ffecom_integer_zero_node;
+  if (TREE_CONSTANT (recexp))
+    {
+      recinit = recexp;
+      recexp = NULL_TREE;
+    }
+  else
+    {
+      recinit = ffecom_integer_zero_node;
+      constantp = FALSE;
+    }
+
+  inits = build_tree_list ((field = TYPE_FIELDS (f2c_cilist_struct)), errinit);
+  initn = inits;
+  ffeste_f2c_init_ (unitinit);
+  ffeste_f2c_init_ (endinit);
+  ffeste_f2c_init_ (formatinit);
+  ffeste_f2c_init_ (recinit);
+
+  inits = build (CONSTRUCTOR, f2c_cilist_struct, NULL_TREE, inits);
+  TREE_CONSTANT (inits) = constantp ? 1 : 0;
+  TREE_STATIC (inits) = 1;
+
+  yes = suspend_momentary ();
+
+  t = build_decl (VAR_DECL,
+		  ffecom_get_invented_identifier ("__g77_cilist_%d", NULL,
+						  mynumber++),
+		  f2c_cilist_struct);
+  TREE_STATIC (t) = 1;
+  t = ffecom_start_decl (t, 1);
+  ffecom_finish_decl (t, inits, 0);
+
+  resume_momentary (yes);
+
+  ffeste_f2c_exp_ (unitfield, unitexp);
+  ffeste_f2c_exp_ (formatfield, formatexp);
+  ffeste_f2c_exp_ (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;
+}
+
+#endif
+/* ffeste_io_cllist_ -- Make arglist with ptr to CLOSE control list
+
+   tree arglist;
+   arglist = ffeste_io_cllist_(...);
+
+   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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffeste_io_cllist_ (bool have_err,
+		   ffebld unit_expr,
+		   ffestpFile *stat_spec)
+{
+  static tree f2c_close_struct = NULL_TREE;
+  tree t;
+  tree ttype;
+  int yes;
+  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;
+
+      push_obstacks_nochange ();
+      end_temporary_allocation ();
+
+      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);
+
+      resume_temporary_allocation ();
+      pop_obstacks ();
+
+      f2c_close_struct = ref;
+    }
+
+  ffeste_f2c_flagspec_ (have_err, errinit);
+
+  unitexp = ffecom_expr (unit_expr);
+  if (TREE_CONSTANT (unitexp))
+    {
+      unitinit = unitexp;
+      unitexp = NULL_TREE;
+    }
+  else
+    {
+      unitinit = ffecom_integer_zero_node;
+      constantp = FALSE;
+    }
+
+  ffeste_f2c_charnolenspec_ (stat_spec, statexp, statinit);
+
+  inits = build_tree_list ((field = TYPE_FIELDS (f2c_close_struct)), errinit);
+  initn = inits;
+  ffeste_f2c_init_ (unitinit);
+  ffeste_f2c_init_ (statinit);
+
+  inits = build (CONSTRUCTOR, f2c_close_struct, NULL_TREE, inits);
+  TREE_CONSTANT (inits) = constantp ? 1 : 0;
+  TREE_STATIC (inits) = 1;
+
+  yes = suspend_momentary ();
+
+  t = build_decl (VAR_DECL,
+		  ffecom_get_invented_identifier ("__g77_cllist_%d", NULL,
+						  mynumber++),
+		  f2c_close_struct);
+  TREE_STATIC (t) = 1;
+  t = ffecom_start_decl (t, 1);
+  ffecom_finish_decl (t, inits, 0);
+
+  resume_momentary (yes);
+
+  ffeste_f2c_exp_ (unitfield, unitexp);
+  ffeste_f2c_exp_ (statfield, statexp);
+
+  ttype = build_pointer_type (TREE_TYPE (t));
+  t = ffecom_1 (ADDR_EXPR, ttype, t);
+
+  t = build_tree_list (NULL_TREE, t);
+
+  return t;
+}
+
+#endif
+/* ffeste_io_icilist_ -- Make arglist with ptr to internal I/O control list
+
+   tree arglist;
+   arglist = ffeste_io_icilist_(...);
+
+   Returns a tree suitable as an argument list containing a pointer to
+   an internal-file 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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffeste_io_icilist_ (bool have_err,
+		    ffebld unit_expr,
+		    bool have_end,
+		    ffestvFormat format,
+		    ffestpFile *format_spec)
+{
+  static tree f2c_icilist_struct = NULL_TREE;
+  tree t;
+  tree ttype;
+  int yes;
+  tree field;
+  tree inits, initn;
+  tree ignore;			/* We ignore the length of format! */
+  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;
+
+      push_obstacks_nochange ();
+      end_temporary_allocation ();
+
+      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);
+
+      resume_temporary_allocation ();
+      pop_obstacks ();
+
+      f2c_icilist_struct = ref;
+    }
+
+  ffeste_f2c_flagspec_ (have_err, errinit);
+
+  unitexp = ffecom_arg_ptr_to_expr (unit_expr, &unitlenexp);
+  if ((ffeinfo_rank (ffebld_info (unit_expr)) == 0)
+      || (TREE_CODE (TREE_TYPE (TREE_TYPE (unitexp))) != ARRAY_TYPE))
+    unitnumexp = ffecom_integer_one_node;
+  else
+    {
+      unitnumexp = size_binop (CEIL_DIV_EXPR,
+		   TYPE_SIZE (TREE_TYPE (TREE_TYPE (unitexp))), unitlenexp);
+      unitnumexp = size_binop (CEIL_DIV_EXPR,
+			       unitnumexp, size_int (TYPE_PRECISION
+						     (char_type_node)));
+    }
+  if (TREE_CONSTANT (unitexp))
+    {
+      unitinit = unitexp;
+      unitexp = NULL_TREE;
+    }
+  else
+    {
+      unitinit = null_pointer_node;
+      constantp = FALSE;
+    }
+  if ((unitlenexp != NULL_TREE) && TREE_CONSTANT (unitlenexp))
+    {
+      unitleninit = unitlenexp;
+      unitlenexp = NULL_TREE;
+    }
+  else
+    {
+      unitleninit = ffecom_integer_zero_node;
+      constantp = FALSE;
+    }
+  if (TREE_CONSTANT (unitnumexp))
+    {
+      unitnuminit = unitnumexp;
+      unitnumexp = NULL_TREE;
+    }
+  else
+    {
+      unitnuminit = ffecom_integer_zero_node;
+      constantp = FALSE;
+    }
+
+  switch (format)
+    {
+    case FFESTV_formatNONE:
+      formatinit = null_pointer_node;
+      formatexp = NULL_TREE;
+      break;
+
+    case FFESTV_formatLABEL:
+      formatexp = NULL_TREE;
+      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_expr (format_spec->u.expr, &ignore);
+      if (TREE_CONSTANT (formatexp))
+	{
+	  formatinit = formatexp;
+	  formatexp = NULL_TREE;
+	}
+      else
+	{
+	  formatinit = null_pointer_node;
+	  constantp = FALSE;
+	}
+      break;
+
+    case FFESTV_formatASTERISK:
+      formatinit = null_pointer_node;
+      formatexp = NULL_TREE;
+      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);
+      formatexp = NULL_TREE;
+      formatinit = ffecom_integer_zero_node;
+      break;
+    }
+
+  ffeste_f2c_flagspec_ (have_end, endinit);
+
+  inits = build_tree_list ((field = TYPE_FIELDS (f2c_icilist_struct)),
+			   errinit);
+  initn = inits;
+  ffeste_f2c_init_ (unitinit);
+  ffeste_f2c_init_ (endinit);
+  ffeste_f2c_init_ (formatinit);
+  ffeste_f2c_init_ (unitleninit);
+  ffeste_f2c_init_ (unitnuminit);
+
+  inits = build (CONSTRUCTOR, f2c_icilist_struct, NULL_TREE, inits);
+  TREE_CONSTANT (inits) = constantp ? 1 : 0;
+  TREE_STATIC (inits) = 1;
+
+  yes = suspend_momentary ();
+
+  t = build_decl (VAR_DECL,
+		  ffecom_get_invented_identifier ("__g77_icilist_%d", NULL,
+						  mynumber++),
+		  f2c_icilist_struct);
+  TREE_STATIC (t) = 1;
+  t = ffecom_start_decl (t, 1);
+  ffecom_finish_decl (t, inits, 0);
+
+  resume_momentary (yes);
+
+  ffeste_f2c_exp_ (unitfield, unitexp);
+  ffeste_f2c_exp_ (formatfield, formatexp);
+  ffeste_f2c_exp_ (unitlenfield, unitlenexp);
+  ffeste_f2c_exp_ (unitnumfield, unitnumexp);
+
+  ttype = build_pointer_type (TREE_TYPE (t));
+  t = ffecom_1 (ADDR_EXPR, ttype, t);
+
+  t = build_tree_list (NULL_TREE, t);
+
+  return t;
+}
+
+#endif
+/* ffeste_io_impdo_ -- Handle implied-DO in I/O list
+
+   ffebld expr;
+   ffeste_io_impdo_(expr);
+
+   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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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;			/* Used for list of items in left part of
+				   impdo. */
+  ffebld item;			/* I/O item from head of given list. */
+  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;
+      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_io_call_ ((*ffeste_io_driver_) (item), TRUE);
+      clear_momentary ();
+    }
+
+  /* Generate end of implied-do construct. */
+
+  ffeste_end_iterdo_ (tvar, tincr, titervar);
+}
+
+#endif
+/* ffeste_io_inlist_ -- Make arglist with ptr to INQUIRE control list
+
+   tree arglist;
+   arglist = ffeste_io_inlist_(...);
+
+   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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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 f2c_inquire_struct = NULL_TREE;
+  tree t;
+  tree ttype;
+  int yes;
+  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;
+
+      push_obstacks_nochange ();
+      end_temporary_allocation ();
+
+      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);
+
+      resume_temporary_allocation ();
+      pop_obstacks ();
+
+      f2c_inquire_struct = ref;
+    }
+
+  ffeste_f2c_flagspec_ (have_err, errinit);
+  ffeste_f2c_intspec_ (unit_spec, unitexp, unitinit);
+  ffeste_f2c_charspec_ (file_spec, fileexp, fileinit, filelenexp, fileleninit);
+  ffeste_f2c_ptrtointspec_ (exist_spec, existexp, existinit);
+  ffeste_f2c_ptrtointspec_ (open_spec, openexp, openinit);
+  ffeste_f2c_ptrtointspec_ (number_spec, numberexp, numberinit);
+  ffeste_f2c_ptrtointspec_ (named_spec, namedexp, namedinit);
+  ffeste_f2c_charspec_ (name_spec, nameexp, nameinit, namelenexp, nameleninit);
+  ffeste_f2c_charspec_ (access_spec, accessexp, accessinit, accesslenexp,
+			accessleninit);
+  ffeste_f2c_charspec_ (sequential_spec, sequentialexp, sequentialinit,
+			sequentiallenexp, sequentialleninit);
+  ffeste_f2c_charspec_ (direct_spec, directexp, directinit, directlenexp,
+			directleninit);
+  ffeste_f2c_charspec_ (form_spec, formexp, forminit, formlenexp, formleninit);
+  ffeste_f2c_charspec_ (formatted_spec, formattedexp, formattedinit,
+			formattedlenexp, formattedleninit);
+  ffeste_f2c_charspec_ (unformatted_spec, unformattedexp, unformattedinit,
+			unformattedlenexp, unformattedleninit);
+  ffeste_f2c_ptrtointspec_ (recl_spec, reclexp, reclinit);
+  ffeste_f2c_ptrtointspec_ (nextrec_spec, nextrecexp, nextrecinit);
+  ffeste_f2c_charspec_ (blank_spec, blankexp, blankinit, blanklenexp,
+			blankleninit);
+
+  inits = build_tree_list ((field = TYPE_FIELDS (f2c_inquire_struct)),
+			   errinit);
+  initn = inits;
+  ffeste_f2c_init_ (unitinit);
+  ffeste_f2c_init_ (fileinit);
+  ffeste_f2c_init_ (fileleninit);
+  ffeste_f2c_init_ (existinit);
+  ffeste_f2c_init_ (openinit);
+  ffeste_f2c_init_ (numberinit);
+  ffeste_f2c_init_ (namedinit);
+  ffeste_f2c_init_ (nameinit);
+  ffeste_f2c_init_ (nameleninit);
+  ffeste_f2c_init_ (accessinit);
+  ffeste_f2c_init_ (accessleninit);
+  ffeste_f2c_init_ (sequentialinit);
+  ffeste_f2c_init_ (sequentialleninit);
+  ffeste_f2c_init_ (directinit);
+  ffeste_f2c_init_ (directleninit);
+  ffeste_f2c_init_ (forminit);
+  ffeste_f2c_init_ (formleninit);
+  ffeste_f2c_init_ (formattedinit);
+  ffeste_f2c_init_ (formattedleninit);
+  ffeste_f2c_init_ (unformattedinit);
+  ffeste_f2c_init_ (unformattedleninit);
+  ffeste_f2c_init_ (reclinit);
+  ffeste_f2c_init_ (nextrecinit);
+  ffeste_f2c_init_ (blankinit);
+  ffeste_f2c_init_ (blankleninit);
+
+  inits = build (CONSTRUCTOR, f2c_inquire_struct, NULL_TREE, inits);
+  TREE_CONSTANT (inits) = constantp ? 1 : 0;
+  TREE_STATIC (inits) = 1;
+
+  yes = suspend_momentary ();
+
+  t = build_decl (VAR_DECL,
+		  ffecom_get_invented_identifier ("__g77_inlist_%d", NULL,
+						  mynumber++),
+		  f2c_inquire_struct);
+  TREE_STATIC (t) = 1;
+  t = ffecom_start_decl (t, 1);
+  ffecom_finish_decl (t, inits, 0);
+
+  resume_momentary (yes);
+
+  ffeste_f2c_exp_ (unitfield, unitexp);
+  ffeste_f2c_exp_ (filefield, fileexp);
+  ffeste_f2c_exp_ (filelenfield, filelenexp);
+  ffeste_f2c_exp_ (existfield, existexp);
+  ffeste_f2c_exp_ (openfield, openexp);
+  ffeste_f2c_exp_ (numberfield, numberexp);
+  ffeste_f2c_exp_ (namedfield, namedexp);
+  ffeste_f2c_exp_ (namefield, nameexp);
+  ffeste_f2c_exp_ (namelenfield, namelenexp);
+  ffeste_f2c_exp_ (accessfield, accessexp);
+  ffeste_f2c_exp_ (accesslenfield, accesslenexp);
+  ffeste_f2c_exp_ (sequentialfield, sequentialexp);
+  ffeste_f2c_exp_ (sequentiallenfield, sequentiallenexp);
+  ffeste_f2c_exp_ (directfield, directexp);
+  ffeste_f2c_exp_ (directlenfield, directlenexp);
+  ffeste_f2c_exp_ (formfield, formexp);
+  ffeste_f2c_exp_ (formlenfield, formlenexp);
+  ffeste_f2c_exp_ (formattedfield, formattedexp);
+  ffeste_f2c_exp_ (formattedlenfield, formattedlenexp);
+  ffeste_f2c_exp_ (unformattedfield, unformattedexp);
+  ffeste_f2c_exp_ (unformattedlenfield, unformattedlenexp);
+  ffeste_f2c_exp_ (reclfield, reclexp);
+  ffeste_f2c_exp_ (nextrecfield, nextrecexp);
+  ffeste_f2c_exp_ (blankfield, blankexp);
+  ffeste_f2c_exp_ (blanklenfield, blanklenexp);
+
+  ttype = build_pointer_type (TREE_TYPE (t));
+  t = ffecom_1 (ADDR_EXPR, ttype, t);
+
+  t = build_tree_list (NULL_TREE, t);
+
+  return t;
+}
+
+#endif
+/* ffeste_io_olist_ -- Make arglist with ptr to OPEN control list
+
+   tree arglist;
+   arglist = ffeste_io_olist_(...);
+
+   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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+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 tree f2c_open_struct = NULL_TREE;
+  tree t;
+  tree ttype;
+  int yes;
+  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;
+
+      push_obstacks_nochange ();
+      end_temporary_allocation ();
+
+      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);
+
+      resume_temporary_allocation ();
+      pop_obstacks ();
+
+      f2c_open_struct = ref;
+    }
+
+  ffeste_f2c_flagspec_ (have_err, errinit);
+
+  unitexp = ffecom_expr (unit_expr);
+  if (TREE_CONSTANT (unitexp))
+    {
+      unitinit = unitexp;
+      unitexp = NULL_TREE;
+    }
+  else
+    {
+      unitinit = ffecom_integer_zero_node;
+      constantp = FALSE;
+    }
+
+  ffeste_f2c_charspec_ (file_spec, fileexp, fileinit, filelenexp, fileleninit);
+  ffeste_f2c_charnolenspec_ (stat_spec, statexp, statinit);
+  ffeste_f2c_charnolenspec_ (access_spec, accessexp, accessinit);
+  ffeste_f2c_charnolenspec_ (form_spec, formexp, forminit);
+  ffeste_f2c_intspec_ (recl_spec, reclexp, reclinit);
+  ffeste_f2c_charnolenspec_ (blank_spec, blankexp, blankinit);
+
+  inits = build_tree_list ((field = TYPE_FIELDS (f2c_open_struct)), errinit);
+  initn = inits;
+  ffeste_f2c_init_ (unitinit);
+  ffeste_f2c_init_ (fileinit);
+  ffeste_f2c_init_ (fileleninit);
+  ffeste_f2c_init_ (statinit);
+  ffeste_f2c_init_ (accessinit);
+  ffeste_f2c_init_ (forminit);
+  ffeste_f2c_init_ (reclinit);
+  ffeste_f2c_init_ (blankinit);
+
+  inits = build (CONSTRUCTOR, f2c_open_struct, NULL_TREE, inits);
+  TREE_CONSTANT (inits) = constantp ? 1 : 0;
+  TREE_STATIC (inits) = 1;
+
+  yes = suspend_momentary ();
+
+  t = build_decl (VAR_DECL,
+		  ffecom_get_invented_identifier ("__g77_olist_%d", NULL,
+						  mynumber++),
+		  f2c_open_struct);
+  TREE_STATIC (t) = 1;
+  t = ffecom_start_decl (t, 1);
+  ffecom_finish_decl (t, inits, 0);
+
+  resume_momentary (yes);
+
+  ffeste_f2c_exp_ (unitfield, unitexp);
+  ffeste_f2c_exp_ (filefield, fileexp);
+  ffeste_f2c_exp_ (filelenfield, filelenexp);
+  ffeste_f2c_exp_ (statfield, statexp);
+  ffeste_f2c_exp_ (accessfield, accessexp);
+  ffeste_f2c_exp_ (formfield, formexp);
+  ffeste_f2c_exp_ (reclfield, reclexp);
+  ffeste_f2c_exp_ (blankfield, blankexp);
+
+  ttype = build_pointer_type (TREE_TYPE (t));
+  t = ffecom_1 (ADDR_EXPR, ttype, t);
+
+  t = build_tree_list (NULL_TREE, t);
+
+  return t;
+}
+
+#endif
+/* ffeste_subr_file_ -- Display file-statement specifier
+
+   ffeste_subr_file_(&specifier);  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+static void
+ffeste_subr_file_ (char *kw, ffestpFile *spec)
+{
+  if (!spec->kw_or_val_present)
+    return;
+  fputs (kw, dmpout);
+  if (spec->value_present)
+    {
+      fputc ('=', dmpout);
+      if (spec->value_is_label)
+	{
+	  assert (spec->value_is_label == 2);	/* Temporary checking only. */
+	  fprintf (dmpout, "%" ffelabValue_f "u",
+		   ffelab_value (spec->u.label));
+	}
+      else
+	ffebld_dump (spec->u.expr);
+    }
+  fputc (',', dmpout);
+}
+#endif
+
+/* ffeste_subr_beru_ -- Generate code for BACKSPACE/ENDFILE/REWIND
+
+   ffeste_subr_beru_(FFECOM_gfrtFBACK);	 */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffeste_subr_beru_ (ffestpBeruStmt *info, ffecomGfrt rt)
+{
+  tree alist;
+  bool iostat;
+  bool errl;
+
+#define specified(something) (info->beru_spec[something].kw_or_val_present)
+
+  ffeste_emit_line_note_ ();
+
+  /* Do the real work. */
+
+  iostat = specified (FFESTP_beruixIOSTAT);
+  errl = specified (FFESTP_beruixERR);
+
+  /* ~~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. */
+
+  ffecom_push_calltemps ();
+
+  alist = ffeste_io_ialist_ (errl || iostat, FFESTV_unitINTEXPR,
+			     info->beru_spec[FFESTP_beruixUNIT].u.expr, 6);
+
+  if (errl)
+    {				/* ERR= */
+      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= */
+      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)
+    {				/* IOSTAT= */
+      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)
+    {				/* no IOSTAT= but ERR= */
+      ffeste_io_iostat_is_temp_ = TRUE;
+      ffeste_io_iostat_
+	= ffecom_push_tempvar (ffecom_integer_type_node,
+			       FFETARGET_charactersizeNONE, -1, FALSE);
+    }
+  else
+    {				/* no IOSTAT=, or ERR= */
+      ffeste_io_iostat_is_temp_ = FALSE;
+      ffeste_io_iostat_ = NULL_TREE;
+    }
+
+  /* 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),
+		   !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);
+    }
+
+  /* If we've got a temp iostat, pop the temp. */
+
+  if (ffeste_io_iostat_is_temp_)
+    ffecom_pop_tempvar (ffeste_io_iostat_);
+
+  ffecom_pop_calltemps ();
+
+#undef specified
+
+  clear_momentary ();
+}
+
+#endif
+/* ffeste_do -- End of statement following DO-term-stmt etc
+
+   ffeste_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 ffeste_eof_()) invokes it with ok==FALSE.  */
+
+void
+ffeste_do (ffestw block)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ END_DO\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_emit_line_note_ ();
+  if (ffestw_do_tvar (block) == 0)
+    expand_end_loop ();		/* DO WHILE and just DO. */
+  else
+    ffeste_end_iterdo_ (ffestw_do_tvar (block),
+			ffestw_do_incr_saved (block),
+			ffestw_do_count_var (block));
+
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_end_R807 -- End of statement following logical IF
+
+   ffeste_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 ffeste_eof_().	*/
+
+void
+ffeste_end_R807 ()
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ END_IF\n", dmpout);	/* Also see ffeste_R806. */
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_emit_line_note_ ();
+  expand_end_cond ();
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_labeldef_branch -- Generate "code" for branch label def
+
+   ffeste_labeldef_branch(label);  */
+
+void
+ffeste_labeldef_branch (ffelab label)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "+ label %lu\n", ffelab_value (label));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree glabel;
+
+    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);
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_labeldef_format -- Generate "code" for FORMAT label def
+
+   ffeste_labeldef_format(label);  */
+
+void
+ffeste_labeldef_format (ffelab label)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "$ label %lu\n", ffelab_value (label));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_label_formatdef_ = label;
+#else
+#error
+#endif
+}
+
+/* ffeste_R737A -- Assignment statement outside of WHERE
+
+   ffeste_R737A(dest_expr,source_expr);	 */
+
+void
+ffeste_R737A (ffebld dest, ffebld source)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ let ", dmpout);
+  ffebld_dump (dest);
+  fputs ("=", dmpout);
+  ffebld_dump (source);
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_emit_line_note_ ();
+  ffecom_push_calltemps ();
+
+  ffecom_expand_let_stmt (dest, source);
+
+  ffecom_pop_calltemps ();
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R803 -- Block IF (IF-THEN) statement
+
+   ffeste_R803(construct_name,expr,expr_token);
+
+   Make sure statement is valid here; implement.  */
+
+void
+ffeste_R803 (ffebld expr)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ IF_block (", dmpout);
+  ffebld_dump (expr);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_emit_line_note_ ();
+  ffecom_push_calltemps ();
+
+  expand_start_cond (ffecom_truth_value (ffecom_expr (expr)), 0);
+
+  ffecom_pop_calltemps ();
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R804 -- ELSE IF statement
+
+   ffeste_R804(expr,expr_token,name_token);
+
+   Make sure ffeste_kind_ identifies an IF block.  If not
+   NULL, make sure name_token gives the correct name.  Implement the else
+   of the IF block.  */
+
+void
+ffeste_R804 (ffebld expr)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ ELSE_IF (", dmpout);
+  ffebld_dump (expr);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_emit_line_note_ ();
+  ffecom_push_calltemps ();
+
+  expand_start_elseif (ffecom_truth_value (ffecom_expr (expr)));
+
+  ffecom_pop_calltemps ();
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R805 -- ELSE statement
+
+   ffeste_R805(name_token);
+
+   Make sure ffeste_kind_ identifies an IF block.  If not
+   NULL, make sure name_token gives the correct name.  Implement the ELSE
+   of the IF block.  */
+
+void
+ffeste_R805 ()
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ ELSE\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_emit_line_note_ ();
+  expand_start_else ();
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R806 -- End an IF-THEN
+
+   ffeste_R806(TRUE);  */
+
+void
+ffeste_R806 ()
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ END_IF_then\n", dmpout);	/* Also see ffeste_shriek_if_. */
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_emit_line_note_ ();
+  expand_end_cond ();
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R807 -- Logical IF statement
+
+   ffeste_R807(expr,expr_token);
+
+   Make sure statement is valid here; implement.  */
+
+void
+ffeste_R807 (ffebld expr)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ IF_logical (", dmpout);
+  ffebld_dump (expr);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_emit_line_note_ ();
+  ffecom_push_calltemps ();
+
+  expand_start_cond (ffecom_truth_value (ffecom_expr (expr)), 0);
+
+  ffecom_pop_calltemps ();
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R809 -- SELECT CASE statement
+
+   ffeste_R809(construct_name,expr,expr_token);
+
+   Make sure statement is valid here; implement.  */
+
+void
+ffeste_R809 (ffestw block, ffebld expr)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ SELECT_CASE (", dmpout);
+  ffebld_dump (expr);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffecom_push_calltemps ();
+
+  {
+    tree texpr;
+
+    ffeste_emit_line_note_ ();
+
+    if ((expr == NULL)
+	|| (ffeinfo_basictype (ffebld_info (expr))
+	    == FFEINFO_basictypeANY))
+      {
+	ffestw_set_select_texpr (block, error_mark_node);
+	clear_momentary ();
+      }
+    else
+      {
+	texpr = ffecom_expr (expr);
+	if (ffeinfo_basictype (ffebld_info (expr))
+	    != FFEINFO_basictypeCHARACTER)
+	  {
+	    expand_start_case (1, texpr, TREE_TYPE (texpr),
+			       "SELECT CASE statement");
+	    ffestw_set_select_texpr (block, texpr);
+	    ffestw_set_select_break (block, FALSE);
+	    push_momentary ();
+	  }
+	else
+	  {
+	    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);
+	  }
+      }
+  }
+
+  ffecom_pop_calltemps ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R810 -- CASE statement
+
+   ffeste_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
+ffeste_R810 (ffestw block, unsigned long casenum)
+{
+  ffestwSelect s = ffestw_select (block);
+  ffestwCase c;
+
+  ffeste_check_simple_ ();
+
+  if (s->first_stmt == (ffestwCase) &s->first_rel)
+    c = NULL;
+  else
+    c = s->first_stmt;
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  if ((c == NULL) || (casenum != c->casenum))
+    {
+      if (casenum == 0)		/* Intentional CASE DEFAULT. */
+	fputs ("+ CASE_DEFAULT", dmpout);
+    }
+  else
+    {
+      bool comma = FALSE;
+
+      fputs ("+ CASE (", dmpout);
+      do
+	{
+	  if (comma)
+	    fputc (',', dmpout);
+	  else
+	    comma = TRUE;
+	  if (c->low != NULL)
+	    ffebld_constant_dump (c->low);
+	  if (c->low != c->high)
+	    {
+	      fputc (':', dmpout);
+	      if (c->high != NULL)
+		ffebld_constant_dump (c->high);
+	    }
+	  c = c->next_stmt;
+	  /* Unlink prev.  */
+	  c->previous_stmt->previous_stmt->next_stmt = c;
+	  c->previous_stmt = c->previous_stmt->previous_stmt;
+	}
+      while ((c != (ffestwCase) &s->first_rel) && (casenum == c->casenum));
+      fputc (')', dmpout);
+    }
+
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree texprlow;
+    tree texprhigh;
+    tree tlabel = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE);
+    int pushok;
+    tree duplicate;
+
+    ffeste_emit_line_note_ ();
+
+    if (TREE_CODE (ffestw_select_texpr (block)) == ERROR_MARK)
+      {
+	clear_momentary ();
+	return;
+      }
+
+    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 (&ffebld_constant_union (c->low), s->type,
+		       s->kindtype, ffecom_tree_type[s->type][s->kindtype]);
+	  if (c->low != c->high)
+	    {
+	      texprhigh = (c->high == NULL) ? NULL_TREE
+		: ffecom_constantunion (&ffebld_constant_union (c->high),
+	      s->type, s->kindtype, ffecom_tree_type[s->type][s->kindtype]);
+	      pushok = pushcase_range (texprlow, texprhigh, convert,
+				       tlabel, &duplicate);
+	    }
+	  else
+	    pushok = pushcase (texprlow, convert, tlabel, &duplicate);
+	  assert (pushok == 0);
+	  c = c->next_stmt;
+	  /* Unlink prev.  */
+	  c->previous_stmt->previous_stmt->next_stmt = c;
+	  c->previous_stmt = c->previous_stmt->previous_stmt;
+	}
+      while ((c != (ffestwCase) &s->first_rel) && (casenum == c->casenum));
+
+    clear_momentary ();
+  }				/* ~~~handle character, character*1 */
+#else
+#error
+#endif
+}
+
+/* ffeste_R811 -- End a SELECT
+
+   ffeste_R811(TRUE);  */
+
+void
+ffeste_R811 (ffestw block)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ END_SELECT\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_emit_line_note_ ();
+
+  if (TREE_CODE (ffestw_select_texpr (block)) == ERROR_MARK)
+    {
+      clear_momentary ();
+      return;
+    }
+
+  expand_end_case (ffestw_select_texpr (block));
+  pop_momentary ();
+  clear_momentary ();		/* ~~~handle character and character*1 */
+#else
+#error
+#endif
+}
+
+/* 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_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  if ((ffebld_op (incr) == FFEBLD_opCONTER)
+      && (ffebld_constant_is_zero (ffebld_conter (incr))))
+    {
+      ffebad_start (FFEBAD_DO_STEP_ZERO);
+      ffebad_here (0, ffelex_token_where_line (incr_token),
+		   ffelex_token_where_column (incr_token));
+      ffebad_string ("Iterative DO loop");
+      ffebad_finish ();
+      /* Don't bother replacing it with 1 yet.  */
+    }
+
+  if (label == NULL)
+    fputs ("+ DO_iterative_nonlabeled (", dmpout);
+  else
+    fprintf (dmpout, "+ DO_iterative_labeled %lu (", ffelab_value (label));
+  ffebld_dump (var);
+  fputc ('=', dmpout);
+  ffebld_dump (start);
+  fputc (',', dmpout);
+  ffebld_dump (end);
+  fputc (',', dmpout);
+  ffebld_dump (incr);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    ffeste_emit_line_note_ ();
+    ffecom_push_calltemps ();
+
+    /* Start the DO loop.  */
+
+    ffeste_begin_iterdo_ (block, NULL, NULL, NULL,
+			  var,
+			  start, start_token,
+			  end, end_token,
+			  incr, incr_token,
+			  "Iterative DO loop");
+
+    ffecom_pop_calltemps ();
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_R819B -- DO WHILE statement
+
+   ffeste_R819B(construct_name,label_token,expr,expr_token);
+
+   Make sure statement is valid here; implement.  */
+
+void
+ffeste_R819B (ffestw block, ffelab label UNUSED, ffebld expr)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  if (label == NULL)
+    fputs ("+ DO_WHILE_nonlabeled (", dmpout);
+  else
+    fprintf (dmpout, "+ DO_WHILE_labeled %lu (", ffelab_value (label));
+  ffebld_dump (expr);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    ffeste_emit_line_note_ ();
+    ffecom_push_calltemps ();
+
+    ffestw_set_do_hook (block, expand_start_loop (1));
+    ffestw_set_do_tvar (block, 0);	/* Means DO WHILE vs. iter DO. */
+    if (expr != NULL)
+      expand_exit_loop_if_false (0, ffecom_truth_value (ffecom_expr (expr)));
+
+    ffecom_pop_calltemps ();
+    clear_momentary ();
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_R825 -- END DO statement
+
+   ffeste_R825(name_token);
+
+   Make sure ffeste_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).  ffeste_do handles the actual
+   generation of end-loop code.	 */
+
+void
+ffeste_R825 ()
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ END_DO_sugar\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_emit_line_note_ ();
+  emit_nop ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R834 -- CYCLE statement
+
+   ffeste_R834(name_token);
+
+   Handle a CYCLE within a loop.  */
+
+void
+ffeste_R834 (ffestw block)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "+ CYCLE block #%lu\n", ffestw_blocknum (block));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_emit_line_note_ ();
+  expand_continue_loop (ffestw_do_hook (block));
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R835 -- EXIT statement
+
+   ffeste_R835(name_token);
+
+   Handle a EXIT within a loop.	 */
+
+void
+ffeste_R835 (ffestw block)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "+ EXIT block #%lu\n", ffestw_blocknum (block));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_emit_line_note_ ();
+  expand_exit_loop (ffestw_do_hook (block));
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R836 -- GOTO statement
+
+   ffeste_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
+ffeste_R836 (ffelab label)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "+ GOTO %lu\n", ffelab_value (label));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree glabel;
+
+    ffeste_emit_line_note_ ();
+    glabel = ffecom_lookup_label (label);
+    if ((glabel != NULL_TREE)
+	&& (TREE_CODE (glabel) != ERROR_MARK))
+      {
+	TREE_USED (glabel) = 1;
+	expand_goto (glabel);
+	clear_momentary ();
+      }
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_R837 -- Computed GOTO statement
+
+   ffeste_R837(labels,count,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
+ffeste_R837 (ffelab *labels, int count, ffebld expr)
+{
+  int i;
+
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ CGOTO (", dmpout);
+  for (i = 0; i < count; ++i)
+    {
+      if (i != 0)
+	fputc (',', dmpout);
+      fprintf (dmpout, "%" ffelabValue_f "u", ffelab_value (labels[i]));
+    }
+  fputs ("),", dmpout);
+  ffebld_dump (expr);
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree texpr;
+    tree value;
+    tree tlabel;
+    int pushok;
+    tree duplicate;
+
+    ffeste_emit_line_note_ ();
+    ffecom_push_calltemps ();
+
+    texpr = ffecom_expr (expr);
+    expand_start_case (0, texpr, TREE_TYPE (texpr), "computed GOTO statement");
+    push_momentary ();		/* In case of lots of labels, keep clearing
+				   them out. */
+    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;
+	TREE_USED (tlabel) = 1;
+	expand_goto (tlabel);
+	clear_momentary ();
+      }
+    pop_momentary ();
+    expand_end_case (texpr);
+
+    ffecom_pop_calltemps ();
+    clear_momentary ();
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_R838 -- ASSIGN statement
+
+   ffeste_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
+ffeste_R838 (ffelab label, ffebld target)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "+ ASSIGN %lu TO ", ffelab_value (label));
+  ffebld_dump (target);
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree expr_tree;
+    tree label_tree;
+    tree target_tree;
+
+    ffeste_emit_line_note_ ();
+    ffecom_push_calltemps ();
+
+    label_tree = ffecom_lookup_label (label);
+    if ((label_tree != NULL_TREE)
+	&& (TREE_CODE (label_tree) != ERROR_MARK))
+      {
+	label_tree = ffecom_1 (ADDR_EXPR,
+			       build_pointer_type (void_type_node),
+			       label_tree);
+	TREE_CONSTANT (label_tree) = 1;
+	target_tree = ffecom_expr_assign_w (target);
+	if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (target_tree)))
+	    < GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (label_tree))))
+	  error ("ASSIGN to variable that is too small");
+	label_tree = convert (TREE_TYPE (target_tree), label_tree);
+	expr_tree = ffecom_modify (void_type_node,
+				   target_tree,
+				   label_tree);
+	expand_expr_stmt (expr_tree);
+	clear_momentary ();
+      }
+
+    ffecom_pop_calltemps ();
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_R839 -- Assigned GOTO statement
+
+   ffeste_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
+ffeste_R839 (ffebld target)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ AGOTO ", dmpout);
+  ffebld_dump (target);
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree t;
+
+    ffeste_emit_line_note_ ();
+    ffecom_push_calltemps ();
+
+    t = ffecom_expr_assign (target);
+    if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (t)))
+	< GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (null_pointer_node))))
+      error ("ASSIGNed GOTO target variable is too small");
+    expand_computed_goto (convert (TREE_TYPE (null_pointer_node), t));
+
+    ffecom_pop_calltemps ();
+    clear_momentary ();
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_R840 -- Arithmetic IF statement
+
+   ffeste_R840(expr,expr_token,neg,zero,pos);
+
+   Make sure the labels are valid; implement.  */
+
+void
+ffeste_R840 (ffebld expr, ffelab neg, ffelab zero, ffelab pos)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ IF_arithmetic (", dmpout);
+  ffebld_dump (expr);
+  fprintf (dmpout, ") %" ffelabValue_f "u,%" ffelabValue_f "u,%" ffelabValue_f "u\n",
+	   ffelab_value (neg), ffelab_value (zero), ffelab_value (pos));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree gneg = ffecom_lookup_label (neg);
+    tree gzero = ffecom_lookup_label (zero);
+    tree gpos = ffecom_lookup_label (pos);
+    tree texpr;
+
+    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;
+
+    ffecom_push_calltemps ();
+
+    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_emit_line_note_ ();
+
+    ffecom_pop_calltemps ();
+    clear_momentary ();
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_R841 -- CONTINUE statement
+
+   ffeste_R841();  */
+
+void
+ffeste_R841 ()
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ CONTINUE\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_emit_line_note_ ();
+  emit_nop ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R842 -- STOP statement
+
+   ffeste_R842(expr);  */
+
+void
+ffeste_R842 (ffebld expr)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  if (expr == NULL)
+    {
+      fputs ("+ STOP\n", dmpout);
+    }
+  else
+    {
+      fputs ("+ STOP_coded ", dmpout);
+      ffebld_dump (expr);
+      fputc ('\n', dmpout);
+    }
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree callit;
+    ffelexToken msg;
+
+    ffeste_emit_line_note_ ();
+    if ((expr == NULL)
+	|| (ffeinfo_basictype (ffebld_info (expr))
+	    == FFEINFO_basictypeANY))
+      {
+	msg = ffelex_token_new_character ("", ffelex_token_where_line
+			       (ffesta_tokens[0]), ffelex_token_where_column
+					  (ffesta_tokens[0]));
+	expr = ffebld_new_conter (ffebld_constant_new_characterdefault
+				  (msg));
+	ffelex_token_kill (msg);
+	ffebld_set_info (expr, ffeinfo_new (FFEINFO_basictypeCHARACTER,
+		    FFEINFO_kindtypeCHARACTERDEFAULT, 0, FFEINFO_kindENTITY,
+					    FFEINFO_whereCONSTANT, 0));
+      }
+    else if (ffeinfo_basictype (ffebld_info (expr))
+	     == FFEINFO_basictypeINTEGER)
+      {
+	char num[50];
+
+	assert (ffebld_op (expr) == FFEBLD_opCONTER);
+	assert (ffeinfo_kindtype (ffebld_info (expr))
+		== FFEINFO_kindtypeINTEGERDEFAULT);
+	sprintf (num, "%" ffetargetIntegerDefault_f "d",
+		 ffebld_constant_integer1 (ffebld_conter (expr)));
+	msg = ffelex_token_new_character (num, ffelex_token_where_line
+			       (ffesta_tokens[0]), ffelex_token_where_column
+					  (ffesta_tokens[0]));
+	expr = ffebld_new_conter (ffebld_constant_new_characterdefault
+				  (msg));
+	ffelex_token_kill (msg);
+	ffebld_set_info (expr, ffeinfo_new (FFEINFO_basictypeCHARACTER,
+		    FFEINFO_kindtypeCHARACTERDEFAULT, 0, FFEINFO_kindENTITY,
+					    FFEINFO_whereCONSTANT, 0));
+      }
+    else
+      {
+	assert (ffeinfo_basictype (ffebld_info (expr))
+		== FFEINFO_basictypeCHARACTER);
+	assert (ffebld_op (expr) == FFEBLD_opCONTER);
+	assert (ffeinfo_kindtype (ffebld_info (expr))
+		== FFEINFO_kindtypeCHARACTERDEFAULT);
+      }
+
+    ffecom_push_calltemps ();
+    callit = ffecom_call_gfrt (FFECOM_gfrtSTOP,
+		    ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)));
+    ffecom_pop_calltemps ();
+    TREE_SIDE_EFFECTS (callit) = 1;
+    expand_expr_stmt (callit);
+    clear_momentary ();
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_R843 -- PAUSE statement
+
+   ffeste_R843(expr,expr_token);
+
+   Make sure statement is valid here; implement.  expr and expr_token are
+   both NULL if there was no expression.  */
+
+void
+ffeste_R843 (ffebld expr)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  if (expr == NULL)
+    {
+      fputs ("+ PAUSE\n", dmpout);
+    }
+  else
+    {
+      fputs ("+ PAUSE_coded ", dmpout);
+      ffebld_dump (expr);
+      fputc ('\n', dmpout);
+    }
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree callit;
+    ffelexToken msg;
+
+    ffeste_emit_line_note_ ();
+    if ((expr == NULL)
+	|| (ffeinfo_basictype (ffebld_info (expr))
+	    == FFEINFO_basictypeANY))
+      {
+	msg = ffelex_token_new_character ("", ffelex_token_where_line
+			       (ffesta_tokens[0]), ffelex_token_where_column
+					  (ffesta_tokens[0]));
+	expr = ffebld_new_conter (ffebld_constant_new_characterdefault
+				  (msg));
+	ffelex_token_kill (msg);
+	ffebld_set_info (expr, ffeinfo_new (FFEINFO_basictypeCHARACTER,
+		    FFEINFO_kindtypeCHARACTERDEFAULT, 0, FFEINFO_kindENTITY,
+					    FFEINFO_whereCONSTANT, 0));
+      }
+    else if (ffeinfo_basictype (ffebld_info (expr))
+	     == FFEINFO_basictypeINTEGER)
+      {
+	char num[50];
+
+	assert (ffebld_op (expr) == FFEBLD_opCONTER);
+	assert (ffeinfo_kindtype (ffebld_info (expr))
+		== FFEINFO_kindtypeINTEGERDEFAULT);
+	sprintf (num, "%" ffetargetIntegerDefault_f "d",
+		 ffebld_constant_integer1 (ffebld_conter (expr)));
+	msg = ffelex_token_new_character (num, ffelex_token_where_line
+			       (ffesta_tokens[0]), ffelex_token_where_column
+					  (ffesta_tokens[0]));
+	expr = ffebld_new_conter (ffebld_constant_new_characterdefault
+				  (msg));
+	ffelex_token_kill (msg);
+	ffebld_set_info (expr, ffeinfo_new (FFEINFO_basictypeCHARACTER,
+		    FFEINFO_kindtypeCHARACTERDEFAULT, 0, FFEINFO_kindENTITY,
+					    FFEINFO_whereCONSTANT, 0));
+      }
+    else
+      {
+	assert (ffeinfo_basictype (ffebld_info (expr))
+		== FFEINFO_basictypeCHARACTER);
+	assert (ffebld_op (expr) == FFEBLD_opCONTER);
+	assert (ffeinfo_kindtype (ffebld_info (expr))
+		== FFEINFO_kindtypeCHARACTERDEFAULT);
+      }
+
+    ffecom_push_calltemps ();
+    callit = ffecom_call_gfrt (FFECOM_gfrtPAUSE,
+		    ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)));
+    ffecom_pop_calltemps ();
+    TREE_SIDE_EFFECTS (callit) = 1;
+    expand_expr_stmt (callit);
+    clear_momentary ();
+  }
+#if 0				/* Old approach for phantom g77 run-time
+				   library. */
+  {
+    tree callit;
+
+    ffeste_emit_line_note_ ();
+    if (expr == NULL)
+      callit = ffecom_call_gfrt (FFECOM_gfrtPAUSENIL, NULL_TREE);
+    else if (ffeinfo_basictype (ffebld_info (expr))
+	     == FFEINFO_basictypeINTEGER)
+      {
+	ffecom_push_calltemps ();
+	callit = ffecom_call_gfrt (FFECOM_gfrtPAUSEINT,
+		    ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)));
+	ffecom_pop_calltemps ();
+      }
+    else
+      {
+	if (ffeinfo_basictype (ffebld_info (expr))
+	    != FFEINFO_basictypeCHARACTER)
+	  break;
+	ffecom_push_calltemps ();
+	callit = ffecom_call_gfrt (FFECOM_gfrtPAUSECHAR,
+		    ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)));
+	ffecom_pop_calltemps ();
+      }
+    TREE_SIDE_EFFECTS (callit) = 1;
+    expand_expr_stmt (callit);
+    clear_momentary ();
+  }
+#endif
+#else
+#error
+#endif
+}
+
+/* ffeste_R904 -- OPEN statement
+
+   ffeste_R904();
+
+   Make sure an OPEN is valid in the current context, and implement it.	 */
+
+void
+ffeste_R904 (ffestpOpenStmt *info)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ OPEN (", dmpout);
+  ffeste_subr_file_ ("UNIT", &info->open_spec[FFESTP_openixUNIT]);
+  ffeste_subr_file_ ("ACCESS", &info->open_spec[FFESTP_openixACCESS]);
+  ffeste_subr_file_ ("ACTION", &info->open_spec[FFESTP_openixACTION]);
+  ffeste_subr_file_ ("ASSOCIATEVARIABLE", &info->open_spec[FFESTP_openixASSOCIATEVARIABLE]);
+  ffeste_subr_file_ ("BLANK", &info->open_spec[FFESTP_openixBLANK]);
+  ffeste_subr_file_ ("BLOCKSIZE", &info->open_spec[FFESTP_openixBLOCKSIZE]);
+  ffeste_subr_file_ ("BUFFERCOUNT", &info->open_spec[FFESTP_openixBUFFERCOUNT]);
+  ffeste_subr_file_ ("CARRIAGECONTROL", &info->open_spec[FFESTP_openixCARRIAGECONTROL]);
+  ffeste_subr_file_ ("DEFAULTFILE", &info->open_spec[FFESTP_openixDEFAULTFILE]);
+  ffeste_subr_file_ ("DELIM", &info->open_spec[FFESTP_openixDELIM]);
+  ffeste_subr_file_ ("DISPOSE", &info->open_spec[FFESTP_openixDISPOSE]);
+  ffeste_subr_file_ ("ERR", &info->open_spec[FFESTP_openixERR]);
+  ffeste_subr_file_ ("EXTENDSIZE", &info->open_spec[FFESTP_openixEXTENDSIZE]);
+  ffeste_subr_file_ ("FILE", &info->open_spec[FFESTP_openixFILE]);
+  ffeste_subr_file_ ("FORM", &info->open_spec[FFESTP_openixFORM]);
+  ffeste_subr_file_ ("INITIALSIZE", &info->open_spec[FFESTP_openixINITIALSIZE]);
+  ffeste_subr_file_ ("IOSTAT", &info->open_spec[FFESTP_openixIOSTAT]);
+  ffeste_subr_file_ ("KEY", &info->open_spec[FFESTP_openixKEY]);
+  ffeste_subr_file_ ("MAXREC", &info->open_spec[FFESTP_openixMAXREC]);
+  ffeste_subr_file_ ("NOSPANBLOCKS", &info->open_spec[FFESTP_openixNOSPANBLOCKS]);
+  ffeste_subr_file_ ("ORGANIZATION", &info->open_spec[FFESTP_openixORGANIZATION]);
+  ffeste_subr_file_ ("PAD", &info->open_spec[FFESTP_openixPAD]);
+  ffeste_subr_file_ ("POSITION", &info->open_spec[FFESTP_openixPOSITION]);
+  ffeste_subr_file_ ("READONLY", &info->open_spec[FFESTP_openixREADONLY]);
+  ffeste_subr_file_ ("RECL", &info->open_spec[FFESTP_openixRECL]);
+  ffeste_subr_file_ ("RECORDTYPE", &info->open_spec[FFESTP_openixRECORDTYPE]);
+  ffeste_subr_file_ ("SHARED", &info->open_spec[FFESTP_openixSHARED]);
+  ffeste_subr_file_ ("STATUS", &info->open_spec[FFESTP_openixSTATUS]);
+  ffeste_subr_file_ ("USEROPEN", &info->open_spec[FFESTP_openixUSEROPEN]);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree args;
+    bool iostat;
+    bool errl;
+
+#define specified(something) (info->open_spec[something].kw_or_val_present)
+
+    ffeste_emit_line_note_ ();
+
+    iostat = specified (FFESTP_openixIOSTAT);
+    errl = specified (FFESTP_openixERR);
+
+    ffecom_push_calltemps ();
+
+    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]);
+
+    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)
+      {				/* IOSTAT= */
+	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)
+      {				/* no IOSTAT= but ERR= */
+	ffeste_io_iostat_is_temp_ = TRUE;
+	ffeste_io_iostat_
+	  = ffecom_push_tempvar (ffecom_integer_type_node,
+				 FFETARGET_charactersizeNONE, -1, FALSE);
+      }
+    else
+      {				/* no IOSTAT=, or ERR= */
+	ffeste_io_iostat_is_temp_ = FALSE;
+	ffeste_io_iostat_ = NULL_TREE;
+      }
+
+    /* 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),
+		     !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);
+      }
+
+    /* If we've got a temp iostat, pop the temp. */
+
+    if (ffeste_io_iostat_is_temp_)
+      ffecom_pop_tempvar (ffeste_io_iostat_);
+
+    ffecom_pop_calltemps ();
+
+#undef specified
+  }
+
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R907 -- CLOSE statement
+
+   ffeste_R907();
+
+   Make sure a CLOSE is valid in the current context, and implement it.	 */
+
+void
+ffeste_R907 (ffestpCloseStmt *info)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ CLOSE (", dmpout);
+  ffeste_subr_file_ ("UNIT", &info->close_spec[FFESTP_closeixUNIT]);
+  ffeste_subr_file_ ("ERR", &info->close_spec[FFESTP_closeixERR]);
+  ffeste_subr_file_ ("IOSTAT", &info->close_spec[FFESTP_closeixIOSTAT]);
+  ffeste_subr_file_ ("STATUS", &info->close_spec[FFESTP_closeixSTATUS]);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree args;
+    bool iostat;
+    bool errl;
+
+#define specified(something) (info->close_spec[something].kw_or_val_present)
+
+    ffeste_emit_line_note_ ();
+
+    iostat = specified (FFESTP_closeixIOSTAT);
+    errl = specified (FFESTP_closeixERR);
+
+    ffecom_push_calltemps ();
+
+    args = ffeste_io_cllist_ (errl || iostat,
+			      info->close_spec[FFESTP_closeixUNIT].u.expr,
+			      &info->close_spec[FFESTP_closeixSTATUS]);
+
+    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)
+      {				/* IOSTAT= */
+	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)
+      {				/* no IOSTAT= but ERR= */
+	ffeste_io_iostat_is_temp_ = TRUE;
+	ffeste_io_iostat_
+	  = ffecom_push_tempvar (ffecom_integer_type_node,
+				 FFETARGET_charactersizeNONE, -1, FALSE);
+      }
+    else
+      {				/* no IOSTAT=, or ERR= */
+	ffeste_io_iostat_is_temp_ = FALSE;
+	ffeste_io_iostat_ = NULL_TREE;
+      }
+
+    /* 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),
+		     !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);
+      }
+
+    /* If we've got a temp iostat, pop the temp. */
+
+    if (ffeste_io_iostat_is_temp_)
+      ffecom_pop_tempvar (ffeste_io_iostat_);
+
+    ffecom_pop_calltemps ();
+
+#undef specified
+  }
+
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R909_start -- READ(...) statement list begin
+
+   ffeste_R909_start(FALSE);
+
+   Verify that READ is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffeste_R909_start (ffestpReadStmt *info, bool only_format UNUSED,
+		   ffestvUnit unit, ffestvFormat format, bool rec,
+		   bool key UNUSED)
+{
+  ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  switch (format)
+    {
+    case FFESTV_formatNONE:
+      if (rec)
+	fputs ("+ READ_ufdac", dmpout);
+      else if (key)
+	fputs ("+ READ_ufidx", dmpout);
+      else
+	fputs ("+ READ_ufseq", dmpout);
+      break;
+
+    case FFESTV_formatLABEL:
+    case FFESTV_formatCHAREXPR:
+    case FFESTV_formatINTEXPR:
+      if (rec)
+	fputs ("+ READ_fmdac", dmpout);
+      else if (key)
+	fputs ("+ READ_fmidx", dmpout);
+      else if (unit == FFESTV_unitCHAREXPR)
+	fputs ("+ READ_fmint", dmpout);
+      else
+	fputs ("+ READ_fmseq", dmpout);
+      break;
+
+    case FFESTV_formatASTERISK:
+      if (unit == FFESTV_unitCHAREXPR)
+	fputs ("+ READ_lsint", dmpout);
+      else
+	fputs ("+ READ_lsseq", dmpout);
+      break;
+
+    case FFESTV_formatNAMELIST:
+      fputs ("+ READ_nlseq", dmpout);
+      break;
+
+    default:
+      assert ("Unexpected kind of format item in R909 READ" == NULL);
+    }
+
+  if (only_format)
+    {
+      fputc (' ', dmpout);
+      ffeste_subr_file_ ("FORMAT", &info->read_spec[FFESTP_readixFORMAT]);
+      fputc (' ', dmpout);
+
+      return;
+    }
+
+  fputs (" (", dmpout);
+  ffeste_subr_file_ ("UNIT", &info->read_spec[FFESTP_readixUNIT]);
+  ffeste_subr_file_ ("FORMAT", &info->read_spec[FFESTP_readixFORMAT]);
+  ffeste_subr_file_ ("ADVANCE", &info->read_spec[FFESTP_readixADVANCE]);
+  ffeste_subr_file_ ("EOR", &info->read_spec[FFESTP_readixEOR]);
+  ffeste_subr_file_ ("ERR", &info->read_spec[FFESTP_readixERR]);
+  ffeste_subr_file_ ("END", &info->read_spec[FFESTP_readixEND]);
+  ffeste_subr_file_ ("IOSTAT", &info->read_spec[FFESTP_readixIOSTAT]);
+  ffeste_subr_file_ ("KEYEQ", &info->read_spec[FFESTP_readixKEYEQ]);
+  ffeste_subr_file_ ("KEYGE", &info->read_spec[FFESTP_readixKEYGE]);
+  ffeste_subr_file_ ("KEYGT", &info->read_spec[FFESTP_readixKEYGT]);
+  ffeste_subr_file_ ("KEYID", &info->read_spec[FFESTP_readixKEYID]);
+  ffeste_subr_file_ ("NULLS", &info->read_spec[FFESTP_readixNULLS]);
+  ffeste_subr_file_ ("REC", &info->read_spec[FFESTP_readixREC]);
+  ffeste_subr_file_ ("SIZE", &info->read_spec[FFESTP_readixSIZE]);
+  fputs (") ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+
+#define specified(something) (info->read_spec[something].kw_or_val_present)
+
+  ffeste_emit_line_note_ ();
+
+  /* Do the real work. */
+
+  {
+    ffecomGfrt start;
+    ffecomGfrt end;
+    tree cilist;
+    bool iostat;
+    bool errl;
+    bool endl;
+
+    /* First determine the start, per-item, and end run-time functions to
+       call.  The per-item function is picked by choosing an ffeste functio
+       to call to handle a given item; it knows how to generate a call to the
+       appropriate run-time function, and is called an "io driver".  It
+       handles the implied-DO construct, for example. */
+
+    switch (format)
+      {
+      case FFESTV_formatNONE:	/* no FMT= */
+	ffeste_io_driver_ = ffeste_io_douio_;
+	if (rec)
+	  start = FFECOM_gfrtSRDUE, end = FFECOM_gfrtERDUE;
+#if 0
+	else if (key)
+	  start = FFECOM_gfrtSRIUE, end = FFECOM_gfrtERIUE;
+#endif
+	else
+	  start = FFECOM_gfrtSRSUE, end = FFECOM_gfrtERSUE;
+	break;
+
+      case FFESTV_formatLABEL:	/* FMT=10 */
+      case FFESTV_formatCHAREXPR:	/* FMT='(I10)' */
+      case FFESTV_formatINTEXPR:	/* FMT=I [after ASSIGN 10 TO I] */
+	ffeste_io_driver_ = ffeste_io_dofio_;
+	if (rec)
+	  start = FFECOM_gfrtSRDFE, end = FFECOM_gfrtERDFE;
+#if 0
+	else if (key)
+	  start = FFECOM_gfrtSRIFE, end = FFECOM_gfrtERIFE;
+#endif
+	else if (unit == FFESTV_unitCHAREXPR)
+	  start = FFECOM_gfrtSRSFI, end = FFECOM_gfrtERSFI;
+	else
+	  start = FFECOM_gfrtSRSFE, end = FFECOM_gfrtERSFE;
+	break;
+
+      case FFESTV_formatASTERISK:	/* FMT=* */
+	ffeste_io_driver_ = ffeste_io_dolio_;
+	if (unit == FFESTV_unitCHAREXPR)
+	  start = FFECOM_gfrtSRSLI, end = FFECOM_gfrtERSLI;
+	else
+	  start = FFECOM_gfrtSRSLE, end = FFECOM_gfrtERSLE;
+	break;
+
+      case FFESTV_formatNAMELIST:	/* FMT=FOO or NML=FOO [NAMELIST
+					   /FOO/] */
+	ffeste_io_driver_ = NULL;	/* No start or driver function. */
+	start = FFECOM_gfrtSRSNE, end = FFECOM_gfrt;
+	break;
+
+      default:
+	assert ("Weird stuff" == NULL);
+	start = FFECOM_gfrt, end = FFECOM_gfrt;
+	break;
+      }
+    ffeste_io_endgfrt_ = end;
+
+    iostat = specified (FFESTP_readixIOSTAT);
+    errl = specified (FFESTP_readixERR);
+    endl = specified (FFESTP_readixEND);
+
+    ffecom_push_calltemps ();
+
+    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 (errl)
+      {				/* ERR= */
+	ffeste_io_err_
+	  = ffecom_lookup_label
+	  (info->read_spec[FFESTP_readixERR].u.label);
+
+	if (endl)
+	  {			/* ERR= END= */
+	    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
+	  {			/* 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= */
+	ffeste_io_err_ = NULL_TREE;
+	if (endl)
+	  {			/* 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
+	  {			/* 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)
+      {				/* IOSTAT= */
+	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)
+      {				/* no IOSTAT= but ERR= or END= or both */
+	ffeste_io_iostat_is_temp_ = TRUE;
+	ffeste_io_iostat_
+	  = ffecom_push_tempvar (ffecom_integer_type_node,
+				 FFETARGET_charactersizeNONE, -1, FALSE);
+      }
+    else
+      {				/* no IOSTAT=, ERR=, or END= */
+	ffeste_io_iostat_is_temp_ = FALSE;
+	ffeste_io_iostat_ = NULL_TREE;
+      }
+
+    /* 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),
+		     !ffeste_io_abort_is_temp_ || (end != FFECOM_gfrt));
+  }
+
+#undef specified
+
+  push_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R909_item -- READ statement i/o item
+
+   ffeste_R909_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffeste_R909_item (ffebld expr, ffelexToken expr_token)
+{
+  ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  ffebld_dump (expr);
+  fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  if (expr == NULL)
+    return;
+  while (ffebld_op (expr) == FFEBLD_opPAREN)
+    expr = ffebld_left (expr);	/* "READ *,(A)" -- really a bug in the user's
+				   code, but I've been told lots of code does
+				   this (blech)! */
+  if (ffebld_op (expr) == FFEBLD_opANY)
+    return;
+  if (ffebld_op (expr) == FFEBLD_opIMPDO)
+    ffeste_io_impdo_ (expr, expr_token);
+  else
+    ffeste_io_call_ ((*ffeste_io_driver_) (expr), TRUE);
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R909_finish -- READ statement list complete
+
+   ffeste_R909_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffeste_R909_finish ()
+{
+  ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+
+  /* Don't generate "if (iostat != 0) goto label;" if label is temp abort
+     label, since we're gonna fall through to there anyway. */
+
+  {
+    if (ffeste_io_endgfrt_ != FFECOM_gfrt)
+      ffeste_io_call_ (ffecom_call_gfrt (ffeste_io_endgfrt_, NULL_TREE),
+		       !ffeste_io_abort_is_temp_);
+
+    clear_momentary ();
+    pop_momentary ();
+
+    /* 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 ();
+	  }
+
+      }
+
+    /* If we've got a temp iostat, pop the temp. */
+
+    if (ffeste_io_iostat_is_temp_)
+      ffecom_pop_tempvar (ffeste_io_iostat_);
+
+    ffecom_pop_calltemps ();
+
+    clear_momentary ();
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_R910_start -- WRITE(...) statement list begin
+
+   ffeste_R910_start();
+
+   Verify that WRITE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffeste_R910_start (ffestpWriteStmt *info, ffestvUnit unit,
+		   ffestvFormat format, bool rec)
+{
+  ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  switch (format)
+    {
+    case FFESTV_formatNONE:
+      if (rec)
+	fputs ("+ WRITE_ufdac (", dmpout);
+      else
+	fputs ("+ WRITE_ufseq_or_idx (", dmpout);
+      break;
+
+    case FFESTV_formatLABEL:
+    case FFESTV_formatCHAREXPR:
+    case FFESTV_formatINTEXPR:
+      if (rec)
+	fputs ("+ WRITE_fmdac (", dmpout);
+      else if (unit == FFESTV_unitCHAREXPR)
+	fputs ("+ WRITE_fmint (", dmpout);
+      else
+	fputs ("+ WRITE_fmseq_or_idx (", dmpout);
+      break;
+
+    case FFESTV_formatASTERISK:
+      if (unit == FFESTV_unitCHAREXPR)
+	fputs ("+ WRITE_lsint (", dmpout);
+      else
+	fputs ("+ WRITE_lsseq (", dmpout);
+      break;
+
+    case FFESTV_formatNAMELIST:
+      fputs ("+ WRITE_nlseq (", dmpout);
+      break;
+
+    default:
+      assert ("Unexpected kind of format item in R910 WRITE" == NULL);
+    }
+
+  ffeste_subr_file_ ("UNIT", &info->write_spec[FFESTP_writeixUNIT]);
+  ffeste_subr_file_ ("FORMAT", &info->write_spec[FFESTP_writeixFORMAT]);
+  ffeste_subr_file_ ("ADVANCE", &info->write_spec[FFESTP_writeixADVANCE]);
+  ffeste_subr_file_ ("EOR", &info->write_spec[FFESTP_writeixEOR]);
+  ffeste_subr_file_ ("ERR", &info->write_spec[FFESTP_writeixERR]);
+  ffeste_subr_file_ ("IOSTAT", &info->write_spec[FFESTP_writeixIOSTAT]);
+  ffeste_subr_file_ ("REC", &info->write_spec[FFESTP_writeixREC]);
+  fputs (") ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+
+#define specified(something) (info->write_spec[something].kw_or_val_present)
+
+  ffeste_emit_line_note_ ();
+
+  /* Do the real work. */
+
+  {
+    ffecomGfrt start;
+    ffecomGfrt end;
+    tree cilist;
+    bool iostat;
+    bool errl;
+
+    /* First determine the start, per-item, and end run-time functions to
+       call.  The per-item function is picked by choosing an ffeste functio
+       to call to handle a given item; it knows how to generate a call to the
+       appropriate run-time function, and is called an "io driver".  It
+       handles the implied-DO construct, for example. */
+
+    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;
+
+    iostat = specified (FFESTP_writeixIOSTAT);
+    errl = specified (FFESTP_writeixERR);
+
+    ffecom_push_calltemps ();
+
+    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);
+      }
+
+    ffeste_io_end_ = NULL_TREE;
+
+    if (errl)
+      {				/* ERR= */
+	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= */
+	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)
+      {				/* IOSTAT= */
+	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)
+      {				/* no IOSTAT= but ERR= */
+	ffeste_io_iostat_is_temp_ = TRUE;
+	ffeste_io_iostat_
+	  = ffecom_push_tempvar (ffecom_integer_type_node,
+				 FFETARGET_charactersizeNONE, -1, FALSE);
+      }
+    else
+      {				/* no IOSTAT=, or ERR= */
+	ffeste_io_iostat_is_temp_ = FALSE;
+	ffeste_io_iostat_ = NULL_TREE;
+      }
+
+    /* 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),
+		     !ffeste_io_abort_is_temp_ || (end != FFECOM_gfrt));
+  }
+
+#undef specified
+
+  push_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R910_item -- WRITE statement i/o item
+
+   ffeste_R910_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffeste_R910_item (ffebld expr, ffelexToken expr_token)
+{
+  ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  ffebld_dump (expr);
+  fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  if (expr == NULL)
+    return;
+  if (ffebld_op (expr) == FFEBLD_opANY)
+    return;
+  if (ffebld_op (expr) == FFEBLD_opIMPDO)
+    ffeste_io_impdo_ (expr, expr_token);
+  else
+    ffeste_io_call_ ((*ffeste_io_driver_) (expr), TRUE);
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R910_finish -- WRITE statement list complete
+
+   ffeste_R910_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffeste_R910_finish ()
+{
+  ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+
+  /* Don't generate "if (iostat != 0) goto label;" if label is temp abort
+     label, since we're gonna fall through to there anyway. */
+
+  {
+    if (ffeste_io_endgfrt_ != FFECOM_gfrt)
+      ffeste_io_call_ (ffecom_call_gfrt (ffeste_io_endgfrt_, NULL_TREE),
+		       !ffeste_io_abort_is_temp_);
+
+    clear_momentary ();
+    pop_momentary ();
+
+    /* 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);
+      }
+
+    /* If we've got a temp iostat, pop the temp. */
+
+    if (ffeste_io_iostat_is_temp_)
+      ffecom_pop_tempvar (ffeste_io_iostat_);
+
+    ffecom_pop_calltemps ();
+
+    clear_momentary ();
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_R911_start -- PRINT statement list begin
+
+   ffeste_R911_start();
+
+   Verify that PRINT is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffeste_R911_start (ffestpPrintStmt *info, ffestvFormat format)
+{
+  ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  switch (format)
+    {
+    case FFESTV_formatLABEL:
+    case FFESTV_formatCHAREXPR:
+    case FFESTV_formatINTEXPR:
+      fputs ("+ PRINT_fm ", dmpout);
+      break;
+
+    case FFESTV_formatASTERISK:
+      fputs ("+ PRINT_ls ", dmpout);
+      break;
+
+    case FFESTV_formatNAMELIST:
+      fputs ("+ PRINT_nl ", dmpout);
+      break;
+
+    default:
+      assert ("Unexpected kind of format item in R911 PRINT" == NULL);
+    }
+  ffeste_subr_file_ ("FORMAT", &info->print_spec[FFESTP_printixFORMAT]);
+  fputc (' ', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+
+  ffeste_emit_line_note_ ();
+
+  /* Do the real work. */
+
+  {
+    ffecomGfrt start;
+    ffecomGfrt end;
+    tree cilist;
+
+    /* First determine the start, per-item, and end run-time functions to
+       call.  The per-item function is picked by choosing an ffeste functio
+       to call to handle a given item; it knows how to generate a call to the
+       appropriate run-time function, and is called an "io driver".  It
+       handles the implied-DO construct, for example. */
+
+    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;
+
+    ffecom_push_calltemps ();
+
+    cilist = ffeste_io_cilist_ (FALSE, FFESTV_unitNONE, NULL, 6, FALSE, format,
+		      &info->print_spec[FFESTP_printixFORMAT], FALSE, NULL);
+
+    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;
+
+    /* 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),
+		     !ffeste_io_abort_is_temp_ || (end != FFECOM_gfrt));
+  }
+
+  push_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R911_item -- PRINT statement i/o item
+
+   ffeste_R911_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffeste_R911_item (ffebld expr, ffelexToken expr_token)
+{
+  ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  ffebld_dump (expr);
+  fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  if (expr == NULL)
+    return;
+  if (ffebld_op (expr) == FFEBLD_opANY)
+    return;
+  if (ffebld_op (expr) == FFEBLD_opIMPDO)
+    ffeste_io_impdo_ (expr, expr_token);
+  else
+    ffeste_io_call_ ((*ffeste_io_driver_) (expr), FALSE);
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R911_finish -- PRINT statement list complete
+
+   ffeste_R911_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffeste_R911_finish ()
+{
+  ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    if (ffeste_io_endgfrt_ != FFECOM_gfrt)
+      ffeste_io_call_ (ffecom_call_gfrt (ffeste_io_endgfrt_, NULL_TREE),
+		       FALSE);
+
+    ffecom_pop_calltemps ();
+
+    clear_momentary ();
+    pop_momentary ();
+    clear_momentary ();
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_R919 -- BACKSPACE statement
+
+   ffeste_R919();
+
+   Make sure a BACKSPACE is valid in the current context, and implement it.  */
+
+void
+ffeste_R919 (ffestpBeruStmt *info)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ BACKSPACE (", dmpout);
+  ffeste_subr_file_ ("UNIT", &info->beru_spec[FFESTP_beruixUNIT]);
+  ffeste_subr_file_ ("ERR", &info->beru_spec[FFESTP_beruixERR]);
+  ffeste_subr_file_ ("IOSTAT", &info->beru_spec[FFESTP_beruixIOSTAT]);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_subr_beru_ (info, FFECOM_gfrtFBACK);
+#else
+#error
+#endif
+}
+
+/* ffeste_R920 -- ENDFILE statement
+
+   ffeste_R920();
+
+   Make sure a ENDFILE is valid in the current context, and implement it.  */
+
+void
+ffeste_R920 (ffestpBeruStmt *info)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ ENDFILE (", dmpout);
+  ffeste_subr_file_ ("UNIT", &info->beru_spec[FFESTP_beruixUNIT]);
+  ffeste_subr_file_ ("ERR", &info->beru_spec[FFESTP_beruixERR]);
+  ffeste_subr_file_ ("IOSTAT", &info->beru_spec[FFESTP_beruixIOSTAT]);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_subr_beru_ (info, FFECOM_gfrtFEND);
+#else
+#error
+#endif
+}
+
+/* ffeste_R921 -- REWIND statement
+
+   ffeste_R921();
+
+   Make sure a REWIND is valid in the current context, and implement it.  */
+
+void
+ffeste_R921 (ffestpBeruStmt *info)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ REWIND (", dmpout);
+  ffeste_subr_file_ ("UNIT", &info->beru_spec[FFESTP_beruixUNIT]);
+  ffeste_subr_file_ ("ERR", &info->beru_spec[FFESTP_beruixERR]);
+  ffeste_subr_file_ ("IOSTAT", &info->beru_spec[FFESTP_beruixIOSTAT]);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_subr_beru_ (info, FFECOM_gfrtFREW);
+#else
+#error
+#endif
+}
+
+/* ffeste_R923A -- INQUIRE statement (non-IOLENGTH version)
+
+   ffeste_R923A(bool by_file);
+
+   Make sure an INQUIRE is valid in the current context, and implement it.  */
+
+void
+ffeste_R923A (ffestpInquireStmt *info, bool by_file UNUSED)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  if (by_file)
+    {
+      fputs ("+ INQUIRE_file (", dmpout);
+      ffeste_subr_file_ ("FILE", &info->inquire_spec[FFESTP_inquireixFILE]);
+    }
+  else
+    {
+      fputs ("+ INQUIRE_unit (", dmpout);
+      ffeste_subr_file_ ("UNIT", &info->inquire_spec[FFESTP_inquireixUNIT]);
+    }
+  ffeste_subr_file_ ("ACCESS", &info->inquire_spec[FFESTP_inquireixACCESS]);
+  ffeste_subr_file_ ("ACTION", &info->inquire_spec[FFESTP_inquireixACTION]);
+  ffeste_subr_file_ ("BLANK", &info->inquire_spec[FFESTP_inquireixBLANK]);
+  ffeste_subr_file_ ("CARRIAGECONTROL", &info->inquire_spec[FFESTP_inquireixCARRIAGECONTROL]);
+  ffeste_subr_file_ ("DEFAULTFILE", &info->inquire_spec[FFESTP_inquireixDEFAULTFILE]);
+  ffeste_subr_file_ ("DELIM", &info->inquire_spec[FFESTP_inquireixDELIM]);
+  ffeste_subr_file_ ("DIRECT", &info->inquire_spec[FFESTP_inquireixDIRECT]);
+  ffeste_subr_file_ ("ERR", &info->inquire_spec[FFESTP_inquireixERR]);
+  ffeste_subr_file_ ("EXIST", &info->inquire_spec[FFESTP_inquireixEXIST]);
+  ffeste_subr_file_ ("FORM", &info->inquire_spec[FFESTP_inquireixFORM]);
+  ffeste_subr_file_ ("FORMATTED", &info->inquire_spec[FFESTP_inquireixFORMATTED]);
+  ffeste_subr_file_ ("IOSTAT", &info->inquire_spec[FFESTP_inquireixIOSTAT]);
+  ffeste_subr_file_ ("KEYED", &info->inquire_spec[FFESTP_inquireixKEYED]);
+  ffeste_subr_file_ ("NAME", &info->inquire_spec[FFESTP_inquireixNAME]);
+  ffeste_subr_file_ ("NAMED", &info->inquire_spec[FFESTP_inquireixNAMED]);
+  ffeste_subr_file_ ("NEXTREC", &info->inquire_spec[FFESTP_inquireixNEXTREC]);
+  ffeste_subr_file_ ("NUMBER", &info->inquire_spec[FFESTP_inquireixNUMBER]);
+  ffeste_subr_file_ ("OPENED", &info->inquire_spec[FFESTP_inquireixOPENED]);
+  ffeste_subr_file_ ("ORGANIZATION", &info->inquire_spec[FFESTP_inquireixORGANIZATION]);
+  ffeste_subr_file_ ("PAD", &info->inquire_spec[FFESTP_inquireixPAD]);
+  ffeste_subr_file_ ("POSITION", &info->inquire_spec[FFESTP_inquireixPOSITION]);
+  ffeste_subr_file_ ("READ", &info->inquire_spec[FFESTP_inquireixREAD]);
+  ffeste_subr_file_ ("READWRITE", &info->inquire_spec[FFESTP_inquireixREADWRITE]);
+  ffeste_subr_file_ ("RECL", &info->inquire_spec[FFESTP_inquireixRECL]);
+  ffeste_subr_file_ ("RECORDTYPE", &info->inquire_spec[FFESTP_inquireixRECORDTYPE]);
+  ffeste_subr_file_ ("SEQUENTIAL", &info->inquire_spec[FFESTP_inquireixSEQUENTIAL]);
+  ffeste_subr_file_ ("UNFORMATTED", &info->inquire_spec[FFESTP_inquireixUNFORMATTED]);
+  ffeste_subr_file_ ("WRITE", &info->inquire_spec[FFESTP_inquireixWRITE]);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree args;
+    bool iostat;
+    bool errl;
+
+#define specified(something) (info->inquire_spec[something].kw_or_val_present)
+
+    ffeste_emit_line_note_ ();
+
+    iostat = specified (FFESTP_inquireixIOSTAT);
+    errl = specified (FFESTP_inquireixERR);
+
+    ffecom_push_calltemps ();
+
+    args = ffeste_io_inlist_ (errl || iostat,
+			      &info->inquire_spec[FFESTP_inquireixUNIT],
+			      &info->inquire_spec[FFESTP_inquireixFILE],
+			      &info->inquire_spec[FFESTP_inquireixEXIST],
+			      &info->inquire_spec[FFESTP_inquireixOPENED],
+			      &info->inquire_spec[FFESTP_inquireixNUMBER],
+			      &info->inquire_spec[FFESTP_inquireixNAMED],
+			      &info->inquire_spec[FFESTP_inquireixNAME],
+			      &info->inquire_spec[FFESTP_inquireixACCESS],
+			    &info->inquire_spec[FFESTP_inquireixSEQUENTIAL],
+			      &info->inquire_spec[FFESTP_inquireixDIRECT],
+			      &info->inquire_spec[FFESTP_inquireixFORM],
+			      &info->inquire_spec[FFESTP_inquireixFORMATTED],
+			   &info->inquire_spec[FFESTP_inquireixUNFORMATTED],
+			      &info->inquire_spec[FFESTP_inquireixRECL],
+			      &info->inquire_spec[FFESTP_inquireixNEXTREC],
+			      &info->inquire_spec[FFESTP_inquireixBLANK]);
+
+    if (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)
+      {				/* IOSTAT= */
+	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)
+      {				/* no IOSTAT= but ERR= */
+	ffeste_io_iostat_is_temp_ = TRUE;
+	ffeste_io_iostat_
+	  = ffecom_push_tempvar (ffecom_integer_type_node,
+				 FFETARGET_charactersizeNONE, -1, FALSE);
+      }
+    else
+      {				/* no IOSTAT=, or ERR= */
+	ffeste_io_iostat_is_temp_ = FALSE;
+	ffeste_io_iostat_ = NULL_TREE;
+      }
+
+    /* 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),
+		     !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);
+      }
+
+    /* If we've got a temp iostat, pop the temp. */
+
+    if (ffeste_io_iostat_is_temp_)
+      ffecom_pop_tempvar (ffeste_io_iostat_);
+
+    ffecom_pop_calltemps ();
+
+#undef specified
+  }
+
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R923B_start -- INQUIRE(IOLENGTH=expr) statement list begin
+
+   ffeste_R923B_start();
+
+   Verify that INQUIRE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffeste_R923B_start (ffestpInquireStmt *info UNUSED)
+{
+  ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ INQUIRE (", dmpout);
+  ffeste_subr_file_ ("IOLENGTH", &info->inquire_spec[FFESTP_inquireixIOLENGTH]);
+  fputs (") ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  assert ("INQUIRE(IOLENGTH=<var>) not implemented yet! ~~~" == NULL);
+  ffeste_emit_line_note_ ();
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R923B_item -- INQUIRE statement i/o item
+
+   ffeste_R923B_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffeste_R923B_item (ffebld expr UNUSED)
+{
+  ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  ffebld_dump (expr);
+  fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R923B_finish -- INQUIRE statement list complete
+
+   ffeste_R923B_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffeste_R923B_finish ()
+{
+  ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R1001 -- FORMAT statement
+
+   ffeste_R1001(format_list);  */
+
+void
+ffeste_R1001 (ffests s)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "$ FORMAT %.*s\n", (int) ffests_length (s), ffests_text (s));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree t;
+    tree ttype;
+    tree maxindex;
+    tree var;
+
+    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;
+
+    push_obstacks_nochange ();
+    end_temporary_allocation ();
+
+    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);
+      }
+
+    resume_temporary_allocation ();
+    pop_obstacks ();
+
+    ffeste_label_formatdef_ = NULL;
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_R1103 -- End a PROGRAM
+
+   ffeste_R1103();  */
+
+void
+ffeste_R1103 ()
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ END_PROGRAM\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_R1112 -- End a BLOCK DATA
+
+   ffeste_R1112(TRUE);	*/
+
+void
+ffeste_R1112 ()
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("* END_BLOCK_DATA\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_R1212 -- CALL statement
+
+   ffeste_R1212(expr,expr_token);
+
+   Make sure statement is valid here; implement.  */
+
+void
+ffeste_R1212 (ffebld expr)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ CALL ", dmpout);
+  ffebld_dump (expr);
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    ffebld args = ffebld_right (expr);
+    ffebld arg;
+    ffebld labels = NULL;	/* First in list of LABTERs. */
+    ffebld prevlabels = NULL;
+    ffebld prevargs = NULL;
+
+    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);
+
+    if (labels == NULL)
+      expand_expr_stmt (ffecom_expr (expr));
+    else
+      {
+	tree texpr;
+	tree value;
+	tree tlabel;
+	int caseno;
+	int pushok;
+	tree duplicate;
+
+	texpr = ffecom_expr (expr);
+	expand_start_case (0, texpr, TREE_TYPE (texpr), "CALL statement");
+	push_momentary ();	/* In case of many labels, keep 'em cleared
+				   out. */
+	for (caseno = 1;
+	     labels != NULL;
+	     ++caseno, labels = ffebld_trail (labels))
+	  {
+	    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 (labels)));
+	    if ((tlabel == NULL_TREE)
+		|| (TREE_CODE (tlabel) == ERROR_MARK))
+	      continue;
+	    TREE_USED (tlabel) = 1;
+	    expand_goto (tlabel);
+	    clear_momentary ();
+	  }
+
+	pop_momentary ();
+	expand_end_case (texpr);
+      }
+    clear_momentary ();
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_R1221 -- End a FUNCTION
+
+   ffeste_R1221(TRUE);	*/
+
+void
+ffeste_R1221 ()
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ END_FUNCTION\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_R1225 -- End a SUBROUTINE
+
+   ffeste_R1225(TRUE);	*/
+
+void
+ffeste_R1225 ()
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "+ END_SUBROUTINE\n");
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_R1226 -- ENTRY statement
+
+   ffeste_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
+ffeste_R1226 (ffesymbol entry)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "+ ENTRY %s", ffesymbol_text (entry));
+  if (ffesymbol_dummyargs (entry) != NULL)
+    {
+      ffebld argh;
+
+      fputc ('(', dmpout);
+      for (argh = ffesymbol_dummyargs (entry);
+	   argh != NULL;
+	   argh = ffebld_trail (argh))
+	{
+	  assert (ffebld_head (argh) != NULL);
+	  switch (ffebld_op (ffebld_head (argh)))
+	    {
+	    case FFEBLD_opSYMTER:
+	      fputs (ffesymbol_text (ffebld_symter (ffebld_head (argh))),
+		     dmpout);
+	      break;
+
+	    case FFEBLD_opSTAR:
+	      fputc ('*', dmpout);
+	      break;
+
+	    default:
+	      fputc ('?', dmpout);
+	      ffebld_dump (ffebld_head (argh));
+	      fputc ('?', dmpout);
+	      break;
+	    }
+	  if (ffebld_trail (argh) != NULL)
+	    fputc (',', dmpout);
+	}
+      fputc (')', dmpout);
+    }
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree label = ffesymbol_hook (entry).length_tree;
+
+    ffeste_emit_line_note_ ();
+
+    DECL_INITIAL (label) = error_mark_node;
+    emit_nop ();
+    expand_label (label);
+
+    clear_momentary ();
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_R1227 -- RETURN statement
+
+   ffeste_R1227(expr);
+
+   Make sure statement is valid here; implement.  expr and expr_token are
+   both NULL if there was no expression.  */
+
+void
+ffeste_R1227 (ffestw block UNUSED, ffebld expr)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  if (expr == NULL)
+    {
+      fputs ("+ RETURN\n", dmpout);
+    }
+  else
+    {
+      fputs ("+ RETURN_alternate ", dmpout);
+      ffebld_dump (expr);
+      fputc ('\n', dmpout);
+    }
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree rtn;
+
+    ffeste_emit_line_note_ ();
+    ffecom_push_calltemps ();
+
+    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 ();
+      }
+
+    ffecom_pop_calltemps ();
+    clear_momentary ();
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_V018_start -- REWRITE(...) statement list begin
+
+   ffeste_V018_start();
+
+   Verify that REWRITE is valid here, and begin accepting items in the
+   list.  */
+
+#if FFESTR_VXT
+void
+ffeste_V018_start (ffestpRewriteStmt *info, ffestvFormat format)
+{
+  ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  switch (format)
+    {
+    case FFESTV_formatNONE:
+      fputs ("+ REWRITE_uf (", dmpout);
+      break;
+
+    case FFESTV_formatLABEL:
+    case FFESTV_formatCHAREXPR:
+    case FFESTV_formatINTEXPR:
+      fputs ("+ REWRITE_fm (", dmpout);
+      break;
+
+    default:
+      assert ("Unexpected kind of format item in V018 REWRITE" == NULL);
+    }
+  ffeste_subr_file_ ("UNIT", &info->rewrite_spec[FFESTP_rewriteixUNIT]);
+  ffeste_subr_file_ ("FMT", &info->rewrite_spec[FFESTP_rewriteixFMT]);
+  ffeste_subr_file_ ("ERR", &info->rewrite_spec[FFESTP_rewriteixERR]);
+  ffeste_subr_file_ ("IOSTAT", &info->rewrite_spec[FFESTP_rewriteixIOSTAT]);
+  fputs (") ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V018_item -- REWRITE statement i/o item
+
+   ffeste_V018_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffeste_V018_item (ffebld expr)
+{
+  ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  ffebld_dump (expr);
+  fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V018_finish -- REWRITE statement list complete
+
+   ffeste_V018_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffeste_V018_finish ()
+{
+  ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V019_start -- ACCEPT statement list begin
+
+   ffeste_V019_start();
+
+   Verify that ACCEPT is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffeste_V019_start (ffestpAcceptStmt *info, ffestvFormat format)
+{
+  ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  switch (format)
+    {
+    case FFESTV_formatLABEL:
+    case FFESTV_formatCHAREXPR:
+    case FFESTV_formatINTEXPR:
+      fputs ("+ ACCEPT_fm ", dmpout);
+      break;
+
+    case FFESTV_formatASTERISK:
+      fputs ("+ ACCEPT_ls ", dmpout);
+      break;
+
+    case FFESTV_formatNAMELIST:
+      fputs ("+ ACCEPT_nl ", dmpout);
+      break;
+
+    default:
+      assert ("Unexpected kind of format item in V019 ACCEPT" == NULL);
+    }
+  ffeste_subr_file_ ("FORMAT", &info->accept_spec[FFESTP_acceptixFORMAT]);
+  fputc (' ', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V019_item -- ACCEPT statement i/o item
+
+   ffeste_V019_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffeste_V019_item (ffebld expr)
+{
+  ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  ffebld_dump (expr);
+  fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V019_finish -- ACCEPT statement list complete
+
+   ffeste_V019_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffeste_V019_finish ()
+{
+  ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+#endif
+/* ffeste_V020_start -- TYPE statement list begin
+
+   ffeste_V020_start();
+
+   Verify that TYPE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffeste_V020_start (ffestpTypeStmt *info UNUSED,
+		   ffestvFormat format UNUSED)
+{
+  ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  switch (format)
+    {
+    case FFESTV_formatLABEL:
+    case FFESTV_formatCHAREXPR:
+    case FFESTV_formatINTEXPR:
+      fputs ("+ TYPE_fm ", dmpout);
+      break;
+
+    case FFESTV_formatASTERISK:
+      fputs ("+ TYPE_ls ", dmpout);
+      break;
+
+    case FFESTV_formatNAMELIST:
+      fputs ("* TYPE_nl ", dmpout);
+      break;
+
+    default:
+      assert ("Unexpected kind of format item in V020 TYPE" == NULL);
+    }
+  ffeste_subr_file_ ("FORMAT", &info->type_spec[FFESTP_typeixFORMAT]);
+  fputc (' ', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V020_item -- TYPE statement i/o item
+
+   ffeste_V020_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffeste_V020_item (ffebld expr UNUSED)
+{
+  ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  ffebld_dump (expr);
+  fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V020_finish -- TYPE statement list complete
+
+   ffeste_V020_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffeste_V020_finish ()
+{
+  ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V021 -- DELETE statement
+
+   ffeste_V021();
+
+   Make sure a DELETE is valid in the current context, and implement it.  */
+
+#if FFESTR_VXT
+void
+ffeste_V021 (ffestpDeleteStmt *info)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ DELETE (", dmpout);
+  ffeste_subr_file_ ("UNIT", &info->delete_spec[FFESTP_deleteixUNIT]);
+  ffeste_subr_file_ ("REC", &info->delete_spec[FFESTP_deleteixREC]);
+  ffeste_subr_file_ ("ERR", &info->delete_spec[FFESTP_deleteixERR]);
+  ffeste_subr_file_ ("IOSTAT", &info->delete_spec[FFESTP_deleteixIOSTAT]);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V022 -- UNLOCK statement
+
+   ffeste_V022();
+
+   Make sure a UNLOCK is valid in the current context, and implement it.  */
+
+void
+ffeste_V022 (ffestpBeruStmt *info)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ UNLOCK (", dmpout);
+  ffeste_subr_file_ ("UNIT", &info->beru_spec[FFESTP_beruixUNIT]);
+  ffeste_subr_file_ ("ERR", &info->beru_spec[FFESTP_beruixERR]);
+  ffeste_subr_file_ ("IOSTAT", &info->beru_spec[FFESTP_beruixIOSTAT]);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V023_start -- ENCODE(...) statement list begin
+
+   ffeste_V023_start();
+
+   Verify that ENCODE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffeste_V023_start (ffestpVxtcodeStmt *info)
+{
+  ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ ENCODE (", dmpout);
+  ffeste_subr_file_ ("C", &info->vxtcode_spec[FFESTP_vxtcodeixC]);
+  ffeste_subr_file_ ("F", &info->vxtcode_spec[FFESTP_vxtcodeixF]);
+  ffeste_subr_file_ ("B", &info->vxtcode_spec[FFESTP_vxtcodeixB]);
+  ffeste_subr_file_ ("ERR", &info->vxtcode_spec[FFESTP_vxtcodeixERR]);
+  ffeste_subr_file_ ("IOSTAT", &info->vxtcode_spec[FFESTP_vxtcodeixIOSTAT]);
+  fputs (") ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V023_item -- ENCODE statement i/o item
+
+   ffeste_V023_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffeste_V023_item (ffebld expr)
+{
+  ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  ffebld_dump (expr);
+  fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V023_finish -- ENCODE statement list complete
+
+   ffeste_V023_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffeste_V023_finish ()
+{
+  ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V024_start -- DECODE(...) statement list begin
+
+   ffeste_V024_start();
+
+   Verify that DECODE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffeste_V024_start (ffestpVxtcodeStmt *info)
+{
+  ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ DECODE (", dmpout);
+  ffeste_subr_file_ ("C", &info->vxtcode_spec[FFESTP_vxtcodeixC]);
+  ffeste_subr_file_ ("F", &info->vxtcode_spec[FFESTP_vxtcodeixF]);
+  ffeste_subr_file_ ("B", &info->vxtcode_spec[FFESTP_vxtcodeixB]);
+  ffeste_subr_file_ ("ERR", &info->vxtcode_spec[FFESTP_vxtcodeixERR]);
+  ffeste_subr_file_ ("IOSTAT", &info->vxtcode_spec[FFESTP_vxtcodeixIOSTAT]);
+  fputs (") ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V024_item -- DECODE statement i/o item
+
+   ffeste_V024_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffeste_V024_item (ffebld expr)
+{
+  ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  ffebld_dump (expr);
+  fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V024_finish -- DECODE statement list complete
+
+   ffeste_V024_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffeste_V024_finish ()
+{
+  ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V025_start -- DEFINEFILE statement list begin
+
+   ffeste_V025_start();
+
+   Verify that DEFINEFILE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffeste_V025_start ()
+{
+  ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ DEFINE_FILE ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V025_item -- DEFINE FILE statement item
+
+   ffeste_V025_item(u,ut,m,mt,n,nt,asv,asvt);
+
+   Implement item.  */
+
+void
+ffeste_V025_item (ffebld u, ffebld m, ffebld n, ffebld asv)
+{
+  ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  ffebld_dump (u);
+  fputc ('(', dmpout);
+  ffebld_dump (m);
+  fputc (',', dmpout);
+  ffebld_dump (n);
+  fputs (",U,", dmpout);
+  ffebld_dump (asv);
+  fputs ("),", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V025_finish -- DEFINE FILE statement list complete
+
+   ffeste_V025_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffeste_V025_finish ()
+{
+  ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V026 -- FIND statement
+
+   ffeste_V026();
+
+   Make sure a FIND is valid in the current context, and implement it.	*/
+
+void
+ffeste_V026 (ffestpFindStmt *info)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ FIND (", dmpout);
+  ffeste_subr_file_ ("UNIT", &info->find_spec[FFESTP_findixUNIT]);
+  ffeste_subr_file_ ("REC", &info->find_spec[FFESTP_findixREC]);
+  ffeste_subr_file_ ("ERR", &info->find_spec[FFESTP_findixERR]);
+  ffeste_subr_file_ ("IOSTAT", &info->find_spec[FFESTP_findixIOSTAT]);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+#endif
diff --git a/gcc/f/ste.h b/gcc/f/ste.h
new file mode 100644
index 00000000000..e2122cecffd
--- /dev/null
+++ b/gcc/f/ste.h
@@ -0,0 +1,168 @@
+/* ste.h -- Private #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_ste
+#define _H_f_ste
+
+/* 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 (ffebld expr);
+void ffeste_R804 (ffebld expr);
+void ffeste_R805 (void);
+void ffeste_R806 (void);
+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);
+#if FFESTR_VXT
+void ffeste_V018_start (ffestpRewriteStmt *info, ffestvFormat format);
+void ffeste_V018_item (ffebld expr);
+void ffeste_V018_finish (void);
+void ffeste_V019_start (ffestpAcceptStmt *info, ffestvFormat format);
+void ffeste_V019_item (ffebld expr);
+void ffeste_V019_finish (void);
+#endif
+void ffeste_V020_start (ffestpTypeStmt *info, ffestvFormat format);
+void ffeste_V020_item (ffebld expr);
+void ffeste_V020_finish (void);
+#if FFESTR_VXT
+void ffeste_V021 (ffestpDeleteStmt *info);
+void ffeste_V022 (ffestpBeruStmt *info);
+void ffeste_V023_start (ffestpVxtcodeStmt *info);
+void ffeste_V023_item (ffebld expr);
+void ffeste_V023_finish (void);
+void ffeste_V024_start (ffestpVxtcodeStmt *info);
+void ffeste_V024_item (ffebld expr);
+void ffeste_V024_finish (void);
+void ffeste_V025_start (void);
+void ffeste_V025_item (ffebld u, ffebld m, ffebld n, ffebld asv);
+void ffeste_V025_finish (void);
+void ffeste_V026 (ffestpFindStmt *info);
+#endif
+
+/* Define macros. */
+
+#define ffeste_init_0()
+#define ffeste_init_1()
+#define ffeste_init_2()
+#define ffeste_init_3()
+#define ffeste_init_4()
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#define ffeste_filename() input_filename
+#define ffeste_filelinenum() lineno
+#define ffeste_set_line(name,num) \
+  (input_filename = (name), lineno = (num))
+#elif FFECOM_targetCURRENT == FFECOM_targetFFE
+#define ffeste_set_line(name,num)
+#else
+#error
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetFFE */
+#define ffeste_terminate_0()
+#define ffeste_terminate_1()
+#define ffeste_terminate_2()
+#define ffeste_terminate_3()
+#define ffeste_terminate_4()
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/storag.c b/gcc/f/storag.c
new file mode 100644
index 00000000000..7ad155b983a
--- /dev/null
+++ b/gcc/f/storag.c
@@ -0,0 +1,573 @@
+/* storag.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 ()
+{
+  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 = (ffestorag) malloc_new_kp (ffe_pool_program_unit (), "ffestorag",
+				 sizeof (*s));
+  s->next = (ffestorag) &sl->first;
+  s->previous = sl->last;
+#ifdef FFECOM_storageHOOK
+  s->hook = FFECOM_storageNULL;
+#endif
+  s->previous->next = s;
+  sl->last = s;
+  s->equivs_.first = s->equivs_.last = (ffestorag) &s->equivs_.first;
+
+  return s;
+}
+
+/* Report info on LOCAL non-sym-assoc'ed entities if needed.  */
+
+void
+ffestorag_report ()
+{
+  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
new file mode 100644
index 00000000000..89c5f95b726
--- /dev/null
+++ b/gcc/f/storag.h
@@ -0,0 +1,167 @@
+/* storag.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_storag
+#define _H_f_storag
+
+/* 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. */
+#ifdef FFECOM_storageHOOK
+    ffecomStorage hook;		/* Whatever the backend needs here. */
+#endif
+    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
diff --git a/gcc/f/stp.c b/gcc/f/stp.c
new file mode 100644
index 00000000000..1f28c2e2283
--- /dev/null
+++ b/gcc/f/stp.c
@@ -0,0 +1,59 @@
+/* stp.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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
new file mode 100644
index 00000000000..6ad9f681fe7
--- /dev/null
+++ b/gcc/f/stp.h
@@ -0,0 +1,508 @@
+/* stp.h -- Private #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_stp
+#define _H_f_stp
+
+/* 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
diff --git a/gcc/f/str-1t.fin b/gcc/f/str-1t.fin
new file mode 100644
index 00000000000..b2c7766afc4
--- /dev/null
+++ b/gcc/f/str-1t.fin
@@ -0,0 +1,135 @@
+{
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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
new file mode 100644
index 00000000000..c8973809af5
--- /dev/null
+++ b/gcc/f/str-2t.fin
@@ -0,0 +1,60 @@
+{
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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
new file mode 100644
index 00000000000..f0475cd6c4b
--- /dev/null
+++ b/gcc/f/str-fo.fin
@@ -0,0 +1,55 @@
+{
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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
new file mode 100644
index 00000000000..12066a59c0d
--- /dev/null
+++ b/gcc/f/str-io.fin
@@ -0,0 +1,43 @@
+{
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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
new file mode 100644
index 00000000000..ef4729e0339
--- /dev/null
+++ b/gcc/f/str-nq.fin
@@ -0,0 +1,55 @@
+{
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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
new file mode 100644
index 00000000000..161a6486187
--- /dev/null
+++ b/gcc/f/str-op.fin
@@ -0,0 +1,57 @@
+{
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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
new file mode 100644
index 00000000000..107d0bb50cf
--- /dev/null
+++ b/gcc/f/str-ot.fin
@@ -0,0 +1,47 @@
+{
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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
+;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
diff --git a/gcc/f/str.c b/gcc/f/str.c
new file mode 100644
index 00000000000..3fa6b86200e
--- /dev/null
+++ b/gcc/f/str.c
@@ -0,0 +1,217 @@
+/* str.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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
new file mode 100644
index 00000000000..84def9a79af
--- /dev/null
+++ b/gcc/f/str.h
@@ -0,0 +1,85 @@
+/* str.h -- Private #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_str
+#define _H_f_str
+
+/* Simple definitions and enumerations. */
+
+#define FFESTR_F90 0		/* Unsupported F90 stuff. */
+#define FFESTR_VXT 0		/* Unsupported VXT stuff. */
+
+/* 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
diff --git a/gcc/f/sts.c b/gcc/f/sts.c
new file mode 100644
index 00000000000..769712c1da1
--- /dev/null
+++ b/gcc/f/sts.c
@@ -0,0 +1,271 @@
+/* sts.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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_1D -- printf("...%ld...",(long)) to a string
+
+   ffests s;
+   ffests_printf_1D(s,"...%ld...",1);
+
+   Like printf, but into a string.  */
+
+void
+ffests_printf_1D (ffests s, char *ctl, long arg1)
+{
+  char quickbuf[40];
+  char *buff;
+  ffestsLength len;
+
+  if ((len = strlen (ctl) + 21) < ARRAY_SIZE (quickbuf))
+    /* No # bigger than 20 digits. */
+    {
+      sprintf (&quickbuf[0], ctl, arg1);
+      ffests_puttext (s, &quickbuf[0], strlen (quickbuf));
+    }
+  else
+    {
+      buff = malloc_new_ks (malloc_pool_image (), "ffests_printf_1D", len);
+      sprintf (buff, ctl, arg1);
+      ffests_puttext (s, buff, strlen (buff));
+      malloc_kill_ks (malloc_pool_image (), buff, len);
+    }
+}
+
+/* ffests_printf_1U -- printf("...%lu...",(unsigned long)) to a string
+
+   ffests s;
+   ffests_printf_1U(s,"...%lu...",1);
+
+   Like printf, but into a string.  */
+
+void
+ffests_printf_1U (ffests s, char *ctl, unsigned long arg1)
+{
+  char quickbuf[40];
+  char *buff;
+  ffestsLength len;
+
+  if ((len = strlen (ctl) + 21) < ARRAY_SIZE (quickbuf))
+    /* No # bigger than 20 digits. */
+    {
+      sprintf (&quickbuf[0], ctl, arg1);
+      ffests_puttext (s, &quickbuf[0], strlen (quickbuf));
+    }
+  else
+    {
+      buff = malloc_new_ks (malloc_pool_image (), "ffests_printf_1U", len);
+      sprintf (buff, ctl, arg1);
+      ffests_puttext (s, buff, strlen (buff));
+      malloc_kill_ks (malloc_pool_image (), buff, len);
+    }
+}
+
+/* ffests_printf_1s -- printf("...%s...",(char *)) to a string
+
+   ffests s;
+   ffests_printf_1s(s,"...%s...","hi there!");
+
+   Like printf, but into a string.  */
+
+void
+ffests_printf_1s (ffests s, char *ctl, char *arg1)
+{
+  char quickbuf[40];
+  char *buff;
+  ffestsLength len;
+
+  if ((len = strlen (ctl) + strlen (arg1) - 1) < ARRAY_SIZE (quickbuf))
+    {
+      sprintf (&quickbuf[0], ctl, arg1);
+      ffests_puttext (s, &quickbuf[0], strlen (quickbuf));
+    }
+  else
+    {
+      buff = malloc_new_ks (malloc_pool_image (), "ffests_printf_1s", len);
+      sprintf (buff, ctl, arg1);
+      ffests_puttext (s, buff, strlen (buff));
+      malloc_kill_ks (malloc_pool_image (), buff, len);
+    }
+}
+
+/* ffests_printf_2Us -- printf("...%lu...%s...",...) to a string
+
+   ffests s;
+   ffests_printf_2Us(s,"...%lu...%s...",1,"hi there!");
+
+   Like printf, but into a string.  */
+
+void
+ffests_printf_2Us (ffests s, char *ctl, unsigned long arg1, char *arg2)
+{
+  char quickbuf[60];
+  char *buff;
+  ffestsLength len;
+
+  if ((len = strlen (ctl) + 21 + strlen (arg2) - 1) < ARRAY_SIZE (quickbuf))
+    /* No # bigger than 20 digits. */
+    {
+      sprintf (&quickbuf[0], ctl, arg1, arg2);
+      ffests_puttext (s, &quickbuf[0], strlen (quickbuf));
+    }
+  else
+    {
+      buff = malloc_new_ks (malloc_pool_image (), "ffests_printf_2Us", len);
+      sprintf (buff, ctl, arg1, arg2);
+      ffests_puttext (s, buff, strlen (buff));
+      malloc_kill_ks (malloc_pool_image (), buff, len);
+    }
+}
+
+/* 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, 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, 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
new file mode 100644
index 00000000000..c8141fe01fb
--- /dev/null
+++ b/gcc/f/sts.h
@@ -0,0 +1,89 @@
+/* sts.h -- Private #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_sts
+#define _H_f_sts
+
+/* 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_1D (ffests s, char *ctl, long arg1);
+void ffests_printf_1U (ffests s, char *ctl, unsigned long arg1);
+void ffests_printf_1s (ffests s, char *ctl, char *arg1);
+void ffests_printf_2Us (ffests s, char *ctl, unsigned long arg1,
+			char *arg2);
+void ffests_putc (ffests s, char c);
+void ffests_puts (ffests s, char *string);
+void ffests_puttext (ffests s, 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
diff --git a/gcc/f/stt.c b/gcc/f/stt.c
new file mode 100644
index 00000000000..d0fd582355b
--- /dev/null
+++ b/gcc/f/stt.c
@@ -0,0 +1,1034 @@
+/* stt.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995, 1997 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 = (ffesttCaseList) 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 ()
+{
+  ffesttCaseList new;
+
+  new = (ffesttCaseList) 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_dump -- Dump list of cases
+
+   ffesttCaseList list;
+   ffestt_caselist_dump(list);
+
+   The cases in the list are dumped with commas separating them.  */
+
+void
+ffestt_caselist_dump (ffesttCaseList list)
+{
+  ffesttCaseList next;
+
+  for (next = list->next; next != list; next = next->next)
+    {
+      if (next != list->next)
+	fputc (',', dmpout);
+      if (next->expr1 != NULL)
+	ffebld_dump (next->expr1);
+      if (next->range)
+	{
+	  fputc (':', dmpout);
+	  if (next->expr2 != NULL)
+	    ffebld_dump (next->expr2);
+	}
+    }
+}
+
+/* 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 = (ffesttDimList) 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 ()
+{
+  ffesttDimList new;
+
+  new = (ffesttDimList) 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_dump -- Dump list of dims
+
+   ffesttDimList list;
+   ffestt_dimlist_dump(list);
+
+   The dims in the list are dumped with commas separating them.	 */
+
+void
+ffestt_dimlist_dump (ffesttDimList list)
+{
+  ffesttDimList next;
+
+  for (next = list->next; next != list; next = next->next)
+    {
+      if (next != list->next)
+	fputc (',', dmpout);
+      if (next->lower != NULL)
+	ffebld_dump (next->lower);
+      fputc (':', dmpout);
+      if (next->upper != NULL)
+	ffebld_dump (next->upper);
+    }
+}
+
+/* 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 = (ffesttExprList) 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 ()
+{
+  ffesttExprList new;
+
+  new = (ffesttExprList) 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) ())
+{
+  ffesttExprList next;
+
+  if (list == NULL)
+    return;
+
+  for (next = list->next; next != list; next = next->next)
+    {
+      (*fn) (next->expr, next->t);
+    }
+}
+
+/* ffestt_exprlist_dump -- Dump list of exprs
+
+   ffesttExprList list;
+   ffestt_exprlist_dump(list);
+
+   The exprs in the list are dumped with commas separating them.  */
+
+void
+ffestt_exprlist_dump (ffesttExprList list)
+{
+  ffesttExprList next;
+
+  for (next = list->next; next != list; next = next->next)
+    {
+      if (next != list->next)
+	fputc (',', dmpout);
+      ffebld_dump (next->expr);
+    }
+}
+
+/* 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 = (ffesttFormatList) 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 = (ffesttFormatList) 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 = (ffesttImpList) 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 ()
+{
+  ffesttImpList new;
+
+  new = (ffesttImpList) 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) ())
+{
+  ffesttImpList next;
+
+  if (list == NULL)
+    return;
+
+  for (next = list->next; next != list; next = next->next)
+    {
+      (*fn) (next->first, next->last);
+    }
+}
+
+/* ffestt_implist_dump -- Dump list of token pairs
+
+   ffesttImpList list;
+   ffestt_implist_dump(list);
+
+   The token pairs in the list are dumped with commas separating them.	*/
+
+void
+ffestt_implist_dump (ffesttImpList list)
+{
+  ffesttImpList next;
+
+  for (next = list->next; next != list; next = next->next)
+    {
+      if (next != list->next)
+	fputc (',', dmpout);
+      assert (ffelex_token_type (next->first) == FFELEX_typeNAME);
+      fputs (ffelex_token_text (next->first), dmpout);
+      if (next->last != NULL)
+	{
+	  fputc ('-', dmpout);
+	  assert (ffelex_token_type (next->last) == FFELEX_typeNAME);
+	  fputs (ffelex_token_text (next->last), dmpout);
+	}
+    }
+}
+
+/* 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 = (ffesttTokenItem) 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 ()
+{
+  ffesttTokenList tl;
+
+  tl = (ffesttTokenList) 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 -- Dump 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) ())
+{
+  ffesttTokenItem ti;
+
+  if (tl == NULL)
+    return;
+
+  for (ti = tl->first; ti != (ffesttTokenItem) &tl->first; ti = ti->next)
+    {
+      (*fn) (ti->t);
+    }
+}
+
+/* ffestt_tokenlist_dump -- Dump list of tokens
+
+   ffesttTokenList tl;
+   ffestt_tokenlist_dump(tl);
+
+   The tokens in the list are dumped with commas separating them.  */
+
+void
+ffestt_tokenlist_dump (ffesttTokenList tl)
+{
+  ffesttTokenItem ti;
+
+  for (ti = tl->first; ti != (ffesttTokenItem) &tl->first; ti = ti->next)
+    {
+      if (ti != tl->first)
+	fputc (',', dmpout);
+      switch (ffelex_token_type (ti->t))
+	{
+	case FFELEX_typeNUMBER:
+	case FFELEX_typeNAME:
+	case FFELEX_typeNAMES:
+	  fputs (ffelex_token_text (ti->t), dmpout);
+	  break;
+
+	case FFELEX_typeASTERISK:
+	  fputc ('*', dmpout);
+	  break;
+
+	default:
+	  assert (FALSE);
+	  fputc ('?', dmpout);
+	  break;
+	}
+    }
+}
+
+/* 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
new file mode 100644
index 00000000000..827841ea983
--- /dev/null
+++ b/gcc/f/stt.h
@@ -0,0 +1,218 @@
+/* stt.h -- Private #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_stt
+#define _H_f_stt
+
+/* 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_dump (ffesttCaseList list);
+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_dump (ffesttDimList list);
+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) ());
+void ffestt_exprlist_dump (ffesttExprList list);
+void ffestt_exprlist_kill (ffesttExprList list);
+ffesttFormatList ffestt_formatlist_append (ffesttFormatList list);
+ffesttFormatList ffestt_formatlist_create (ffesttFormatList parent,
+					   ffelexToken t);
+void ffestt_formatlist_dump (ffesttFormatList list);
+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) ());
+void ffestt_implist_dump (ffesttImpList list);
+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) ());
+void ffestt_tokenlist_dump (ffesttTokenList list);
+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
diff --git a/gcc/f/stu.c b/gcc/f/stu.c
new file mode 100644
index 00000000000..138a070e5d3
--- /dev/null
+++ b/gcc/f/stu.c
@@ -0,0 +1,1161 @@
+/* stu.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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) (),
+					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;
+	  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 ()
+	      && 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 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) (), ffebld list)
+{
+  static 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
new file mode 100644
index 00000000000..1b1718c048f
--- /dev/null
+++ b/gcc/f/stu.h
@@ -0,0 +1,69 @@
+/* stu.h -- Private #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_stu
+#define _H_f_stu
+
+/* 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
diff --git a/gcc/f/stv.c b/gcc/f/stv.c
new file mode 100644
index 00000000000..bd62e699865
--- /dev/null
+++ b/gcc/f/stv.c
@@ -0,0 +1,66 @@
+/* stv.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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
new file mode 100644
index 00000000000..6cd9299aaf2
--- /dev/null
+++ b/gcc/f/stv.h
@@ -0,0 +1,165 @@
+/* stv.h -- Private #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_stv
+#define _H_f_stv
+
+/* 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
diff --git a/gcc/f/stw.c b/gcc/f/stw.c
new file mode 100644
index 00000000000..70d8803dcb0
--- /dev/null
+++ b/gcc/f/stw.c
@@ -0,0 +1,428 @@
+/* stw.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 ()
+{
+  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 ()
+{
+  ffestw b;
+
+  ffestw_stack_top_ = b = (ffestw) 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 ()
+{
+  ffestw b;
+
+  b = (ffestw) 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 ()
+{
+  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
new file mode 100644
index 00000000000..54643b833d4
--- /dev/null
+++ b/gcc/f/stw.h
@@ -0,0 +1,184 @@
+/* stw.h -- Private #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_stw
+#define _H_f_stw
+
+/* 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. */
+    char uses_;			/* # uses (new+use-kill calls). */
+    ffestvState state_;
+    int substate_;		/* Used on a per-block-state basis. */
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+    struct nesting *do_hook_;	/* backend id for given loop (EXIT/CYCLE). */
+    tree do_tvar_;		/* tree form of do_iter_var. */
+    tree do_incr_saved_;	/* tree SAVED_EXPR of incr expr. */
+    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;". */
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC*/
+  };
+
+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 ffestw_kill (ffestw block);
+void ffestw_init_0 (void);
+ffestw ffestw_new ();
+ffestw ffestw_pop ();
+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_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_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
diff --git a/gcc/f/symbol.c b/gcc/f/symbol.c
new file mode 100644
index 00000000000..7199cdb9c7c
--- /dev/null
+++ b/gcc/f/symbol.c
@@ -0,0 +1,1469 @@
+/* Implementation of Fortran symbol manager
+   Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+#define FFESYMBOL_globalCURRENT_ FFESYMBOL_globalPROGUNIT_
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+/* Would be good to understand why PROGUNIT in this case too.
+   (1995-08-22).  */
+#define FFESYMBOL_globalCURRENT_ FFESYMBOL_globalPROGUNIT_
+#else
+#error
+#endif
+
+/* Choose how to handle memory pools based on global symbol stuff.  */
+
+#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 char *ffesymbol_state_name_[] =
+{
+  "?",
+  "@",
+  "&",
+  "$",
+};
+
+/* List of attribute names. */
+
+static char *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_ ()
+{
+  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 = (ffesymbol) 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;
+#ifdef FFECOM_symbolHOOK
+  s->hook = FFECOM_symbolNULL;
+#endif
+  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;
+
+  ffename_set_symbol (n, s);
+
+  if (!ffesymbol_retractable_)
+    {
+      s->have_old = FALSE;
+      return s;
+    }
+
+  r = (ffesymbolRetract_) 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.  */
+
+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) ())
+{
+  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) ())
+{
+  ffename_space_drive_symbol (ffesymbol_sfunc_, fn);
+}
+
+/* Dump info on the symbol for debugging purposes.  */
+
+void
+ffesymbol_dump (ffesymbol s)
+{
+  ffeinfoKind k;
+  ffeinfoWhere w;
+
+  assert (s != NULL);
+
+  if (ffeinfo_size (s->info) != FFETARGET_charactersizeNONE)
+    fprintf (dmpout, "%s:%d%s%s*%" ffetargetCharacterSize_f "u",
+	     ffesymbol_text (s),
+	     (int) ffeinfo_rank (s->info),
+	     ffeinfo_basictype_string (ffeinfo_basictype (s->info)),
+	     ffeinfo_kindtype_string (ffeinfo_kindtype (s->info)),
+	     ffeinfo_size (s->info));
+  else
+    fprintf (dmpout, "%s:%d%s%s",
+	     ffesymbol_text (s),
+	     (int) ffeinfo_rank (s->info),
+	     ffeinfo_basictype_string (ffeinfo_basictype (s->info)),
+	     ffeinfo_kindtype_string (ffeinfo_kindtype (s->info)));
+  if ((k = ffeinfo_kind (s->info)) != FFEINFO_kindNONE)
+    fprintf (dmpout, "/%s", ffeinfo_kind_string (k));
+  if ((w = ffeinfo_where (s->info)) != FFEINFO_whereNONE)
+    fprintf (dmpout, "@%s", ffeinfo_where_string (w));
+
+  if ((s->generic != FFEINTRIN_genNONE)
+      || (s->specific != FFEINTRIN_specNONE)
+      || (s->implementation != FFEINTRIN_impNONE))
+    fprintf (dmpout, "{%s:%s:%s}",
+	     ffeintrin_name_generic (s->generic),
+	     ffeintrin_name_specific (s->specific),
+	     ffeintrin_name_implementation (s->implementation));
+}
+
+/* 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 ()
+{
+  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 ()
+{
+#if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalFILE_
+  ffesymbol_global_ = ffename_space_new (ffe_pool_file ());
+#endif
+}
+
+void
+ffesymbol_init_2 ()
+{
+}
+
+void
+ffesymbol_init_3 ()
+{
+#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 ()
+{
+  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);
+}
+
+/* Report info on the symbol for debugging purposes.  */
+
+ffesymbol
+ffesymbol_report (ffesymbol s)
+{
+  ffeinfoKind k;
+  ffeinfoWhere w;
+
+  assert (s != NULL);
+
+  if (s->reported)
+    return s;
+
+  s->reported = TRUE;
+
+  if (ffeinfo_size (s->info) != FFETARGET_charactersizeNONE)
+    fprintf (dmpout, "\"%s\": %s %s %d%s%s*%" ffetargetCharacterSize_f "u",
+	     ffesymbol_text (s),
+	     ffesymbol_state_string (s->state),
+	     ffesymbol_attrs_string (s->attrs),
+	     (int) ffeinfo_rank (s->info),
+	     ffeinfo_basictype_string (ffeinfo_basictype (s->info)),
+	     ffeinfo_kindtype_string (ffeinfo_kindtype (s->info)),
+	     ffeinfo_size (s->info));
+  else
+    fprintf (dmpout, "\"%s\": %s %s %d%s%s",
+	     ffesymbol_text (s),
+	     ffesymbol_state_string (s->state),
+	     ffesymbol_attrs_string (s->attrs),
+	     (int) ffeinfo_rank (s->info),
+	     ffeinfo_basictype_string (ffeinfo_basictype (s->info)),
+	     ffeinfo_kindtype_string (ffeinfo_kindtype (s->info)));
+  if ((k = ffeinfo_kind (s->info)) != FFEINFO_kindNONE)
+    fprintf (dmpout, "/%s", ffeinfo_kind_string (k));
+  if ((w = ffeinfo_where (s->info)) != FFEINFO_whereNONE)
+    fprintf (dmpout, "@%s", ffeinfo_where_string (w));
+  fputc ('\n', dmpout);
+
+  if (s->dims != NULL)
+    {
+      fprintf (dmpout, "  dims: ");
+      ffebld_dump (s->dims);
+      fputs ("\n", dmpout);
+    }
+
+  if (s->extents != NULL)
+    {
+      fprintf (dmpout, "  extents: ");
+      ffebld_dump (s->extents);
+      fputs ("\n", dmpout);
+    }
+
+  if (s->dim_syms != NULL)
+    {
+      fprintf (dmpout, "  dim syms: ");
+      ffebld_dump (s->dim_syms);
+      fputs ("\n", dmpout);
+    }
+
+  if (s->array_size != NULL)
+    {
+      fprintf (dmpout, "  array size: ");
+      ffebld_dump (s->array_size);
+      fputs ("\n", dmpout);
+    }
+
+  if (s->init != NULL)
+    {
+      fprintf (dmpout, "  init-value: ");
+      if (ffebld_op (s->init) == FFEBLD_opANY)
+	fputs ("<any>\n", dmpout);
+      else
+	{
+	  ffebld_dump (s->init);
+	  fputs ("\n", dmpout);
+	}
+    }
+
+  if (s->accretion != NULL)
+    {
+      fprintf (dmpout, "  accretion (%" ffetargetOffset_f "d left): ",
+	       s->accretes);
+      ffebld_dump (s->accretion);
+      fputs ("\n", dmpout);
+    }
+  else if (s->accretes != 0)
+    fprintf (dmpout, "  accretes!! = %" ffetargetOffset_f "d left\n",
+	     s->accretes);
+
+  if (s->dummy_args != NULL)
+    {
+      fprintf (dmpout, "  dummies: ");
+      ffebld_dump (s->dummy_args);
+      fputs ("\n", dmpout);
+    }
+
+  if (s->namelist != NULL)
+    {
+      fprintf (dmpout, "  namelist: ");
+      ffebld_dump (s->namelist);
+      fputs ("\n", dmpout);
+    }
+
+  if (s->common_list != NULL)
+    {
+      fprintf (dmpout, "  common-list: ");
+      ffebld_dump (s->common_list);
+      fputs ("\n", dmpout);
+    }
+
+  if (s->sfunc_expr != NULL)
+    {
+      fprintf (dmpout, "  sfunc expression: ");
+      ffebld_dump (s->sfunc_expr);
+      fputs ("\n", dmpout);
+    }
+
+  if (s->is_save)
+    {
+      fprintf (dmpout, "  SAVEd\n");
+    }
+
+  if (s->is_init)
+    {
+      fprintf (dmpout, "  initialized\n");
+    }
+
+  if (s->do_iter)
+    {
+      fprintf (dmpout, "  DO-loop iteration variable (currently)\n");
+    }
+
+  if (s->explicit_where)
+    {
+      fprintf (dmpout, "  Explicit INTRINSIC/EXTERNAL\n");
+    }
+
+  if (s->namelisted)
+    {
+      fprintf (dmpout, "  Namelisted\n");
+    }
+
+  if (s->common != NULL)
+    {
+      fprintf (dmpout, "  COMMON area: %s\n", ffesymbol_text (s->common));
+    }
+
+  if (s->equiv != NULL)
+    {
+      fprintf (dmpout, "  EQUIVALENCE information: ");
+      ffeequiv_dump (s->equiv);
+      fputs ("\n", dmpout);
+    }
+
+  if (s->storage != NULL)
+    {
+      fprintf (dmpout, "  Storage: ");
+      ffestorag_dump (s->storage);
+      fputs ("\n", dmpout);
+    }
+
+  return s;
+}
+
+/* Report info on the symbols.	*/
+
+void
+ffesymbol_report_all ()
+{
+  ffename_space_drive_symbol (ffesymbol_sfunc_, ffesymbol_report);
+  ffename_space_drive_symbol (ffesymbol_local_, ffesymbol_report);
+  ffename_space_drive_symbol (ffesymbol_global_, ffesymbol_report);
+}
+
+/* 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 ()
+{
+  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 = (ffesymbolRetract_) malloc_new_kp (ffesymbol_retract_pool_,
+					 "FFESYMBOL retract", sizeof (*r));
+  r->next = NULL;
+  r->command = FFESYMBOL_retractcommandRETRACT_;
+  r->live = s;
+  r->symbol = sym = (ffesymbol) malloc_new_ks (FFESYMBOL_SPACE_POOL_,
+					       "FFESYMBOL", sizeof (*sym));
+  *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.  */
+
+char *
+ffesymbol_state_string (ffesymbolState state)
+{
+  if (state >= ARRAY_SIZE (ffesymbol_state_name_))
+    return "?\?\?";
+  return ffesymbol_state_name_[state];
+}
+
+void
+ffesymbol_terminate_0 ()
+{
+}
+
+void
+ffesymbol_terminate_1 ()
+{
+#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 ()
+{
+#if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalPROGUNIT_
+  ffesymbol_kill_manifest_ ();
+#endif
+}
+
+void
+ffesymbol_terminate_3 ()
+{
+#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 ()
+{
+  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
new file mode 100644
index 00000000000..ad100d4ebbe
--- /dev/null
+++ b/gcc/f/symbol.def
@@ -0,0 +1,654 @@
+/* Definitions and documentations for attributes used in GNU F77 compiler
+   Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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
new file mode 100644
index 00000000000..efa91bb01b6
--- /dev/null
+++ b/gcc/f/symbol.h
@@ -0,0 +1,289 @@
+/* Interface definitions for Fortran symbol manager
+   Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_symbol
+#define _H_f_symbol
+
+/* 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? */
+#ifdef FFECOM_symbolHOOK
+    ffecomSymbol hook;		/* Whatever the compiler/backend wants! */
+#endif
+    ffesymbol sfa_dummy_parent;	/* "X" outside sfunc "CIRC(X) = 3.14 * X". */
+    ffesymbol func_result;	/* FUN sym's corresponding RES sym, & vice
+				   versa. */
+    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). */
+  };
+
+#define ffesymbol_accretes(s) ((s)->accretes)
+#define ffesymbol_accretion(s) ((s)->accretion)
+#define ffesymbol_arraysize(s) ((s)->array_size)
+#define ffesymbol_attr(s,a) ((s)->attrs & ((ffesymbolAttrs) 1 << (a)))
+#define ffesymbol_attrs(s) ((s)->attrs)
+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) ());
+void ffesymbol_drive_sfnames (ffesymbol (*fn) ());
+#define ffesymbol_dummyargs(s) ((s)->dummy_args)
+void ffesymbol_dump (ffesymbol s);
+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);
+ffesymbol ffesymbol_report (ffesymbol s);
+void ffesymbol_report_all (void);
+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_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)
+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
diff --git a/gcc/f/target.c b/gcc/f/target.c
new file mode 100644
index 00000000000..828e7adcf75
--- /dev/null
+++ b/gcc/f/target.c
@@ -0,0 +1,2487 @@
+/* target.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995-1997 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 <ctype.h>
+#include "glimits.j"
+#include "target.h"
+#include "bad.h"
+#include "info.h"
+#include "lex.h"
+#include "malloc.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. */
+
+#ifdef REAL_VALUE_ATOF
+#define FFETARGET_ATOF_(p,m) REAL_VALUE_ATOF ((p),(m))
+#else
+#define FFETARGET_ATOF_(p,m) atof ((p))
+#endif
+
+
+/* ffetarget_print_char_ -- Print a single character (in apostrophe context)
+
+   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) && isascii (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 (*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;
+      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;
+
+  min_pad = ~(ffetargetAlign) 0;/* Set to largest value. */
+
+  /* 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)
+	{
+	  if (m > um)		/* This code is similar to the "easy case"
+				   code above. */
+	    pad = ua - (m - um);
+	  else
+	    pad = um - m;
+	  pad = (offset + pad) % ua;
+	  if (pad != 0)
+	    pad = ua - pad;
+	  else
+	    {			/* A zero pad means we've got something
+				   useful. */
+	      *updated_alignment = ua;
+	      *updated_modulo = um;
+	      return 0;
+	    }
+	  if (pad < min_pad)
+	    {			/* New minimum padding value. */
+	      min_pad = pad;
+	      min_m = um;
+	    }
+	}
+    }
+
+  *updated_alignment = ua;
+  *updated_modulo = min_m;
+  return min_pad;
+}
+
+#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);
+      memcpy (val->text, ffelex_token_text (character), val->length);
+    }
+
+  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
+
+   Compare lengths, if equal then use memcmp.  */
+
+#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);
+      if (l.length != 0)
+	memcpy (res->text, l.text, l.length);
+      if (r.length != 0)
+	memcpy (res->text + l.length, r.text, r.length);
+    }
+
+  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 (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
+
+   Compare lengths, if equal then use memcmp.  */
+
+#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);
+      memcpy (res->text, l.text + first - 1, *len);
+    }
+
+  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;
+}
+
+#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);
+      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);
+	}
+    }
+
+  return FFEBAD;
+}
+
+#endif
+#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);
+      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_integer1 -- Raw conversion.  */
+
+#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);
+      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_logical1 -- Raw conversion.  */
+
+#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);
+      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.  */
+
+#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);
+      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
+
+   See prototype.
+
+   Token use count not affected overall.  */
+
+bool
+ffetarget_hollerith (ffetargetHollerith *val, ffelexToken integer,
+		     mallocPool pool)
+{
+  val->length = ffelex_token_length (integer);
+  val->text = malloc_new_kp (pool, "ffetargetHollerith", val->length);
+  memcpy (val->text, ffelex_token_text (integer), val->length);
+
+  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 ((c >= 'A') && (c <= 'F'))
+	c = c - 'A' + 10;
+      else if ((c >= 'a') && (c <= 'f'))
+	c = c - 'a' + 10;
+      else if ((c >= '0') && (c <= '9'))
+	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_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 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 = (char *) 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';
+
+  ffetarget_make_real1 (value,
+			FFETARGET_ATOF_ (ptr,
+					 SFmode));
+
+  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 = (char *) 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';
+
+  ffetarget_make_real2 (value,
+			FFETARGET_ATOF_ (ptr,
+					 DFmode));
+
+  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 (isdigit (c))
+	new_value += c - '0';
+      else if ((c >= 'A') && (c <= 'F'))
+	new_value += c - 'A' + 10;
+      else if ((c >= 'a') && (c <= 'f'))
+	new_value += c - 'a' + 10;
+      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)
+{
+  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
new file mode 100644
index 00000000000..216d7704bd3
--- /dev/null
+++ b/gcc/f/target.h
@@ -0,0 +1,1865 @@
+/* target.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_target
+#define _H_f_target
+
+#ifdef FFE_STANDALONE
+#define HOST_WIDE_INT long
+#else
+#ifndef TREE_CODE
+#include "tree.j"
+#endif
+#endif
+
+/* For now, g77 requires the ability to determine the exact bit pattern
+   of a float on the target machine.  (Hopefully this will be changed
+   soon).  Make sure we can do this.  */
+
+#if !defined (REAL_ARITHMETIC) \
+  && ((TARGET_FLOAT_FORMAT != HOST_FLOAT_FORMAT) \
+      || (FLOAT_WORDS_BIG_ENDIAN != HOST_FLOAT_WORDS_BIG_ENDIAN))
+#error "g77 requires ability to access exact FP representation of target machine"
+#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
+
+/* 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
+#ifndef __alpha__
+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_okINTEGER5
+typedef ? ffetargetInteger5;
+#define ffetargetInteger5_f
+?
+#endif
+#if FFETARGET_okINTEGER6
+typedef ? ffetargetInteger6;
+#define ffetargetInteger6_f
+?
+#endif
+#if FFETARGET_okINTEGER7
+typedef ? ffetargetInteger7;
+#define ffetargetInteger7_f
+?
+#endif
+#if FFETARGET_okINTEGER8
+typedef ? ffetargetInteger8;
+#define ffetargetInteger8_f
+?
+#endif
+#if FFETARGET_okLOGICAL1
+#ifndef __alpha__
+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_okLOGICAL5
+typedef ? ffetargetLogical5;
+#define ffetargetLogical5_f
+?
+#endif
+#if FFETARGET_okLOGICAL6
+typedef ? ffetargetLogical6;
+#define ffetargetLogical6_f
+?
+#endif
+#if FFETARGET_okLOGICAL7
+typedef ? ffetargetLogical7;
+#define ffetargetLogical7_f
+?
+#endif
+#if FFETARGET_okLOGICAL8
+typedef ? ffetargetLogical8;
+#define ffetargetLogical8_f
+?
+#endif
+#if FFETARGET_okREAL1
+#ifdef REAL_ARITHMETIC
+#ifndef __alpha__
+typedef long int ffetargetReal1;
+#define ffetargetReal1_f "l"
+#define ffetarget_cvt_r1_to_rv_ REAL_VALUE_UNTO_TARGET_SINGLE
+#define ffetarget_cvt_rv_to_r1_ REAL_VALUE_TO_TARGET_SINGLE
+#else
+typedef int ffetargetReal1;
+#define ffetargetReal1_f ""
+#define ffetarget_cvt_r1_to_rv_(in) \
+  ({ REAL_VALUE_TYPE _rv; \
+     _rv = REAL_VALUE_UNTO_TARGET_SINGLE ((long) (in)); \
+     _rv; })
+#define ffetarget_cvt_rv_to_r1_(in, out) \
+  ({ long _tmp; \
+     REAL_VALUE_TO_TARGET_SINGLE ((in), _tmp); \
+     (out) = (ffetargetReal1) _tmp; })
+#endif
+#else	/* REAL_ARITHMETIC */
+typedef float ffetargetReal1;
+#define ffetargetReal1_f ""
+#endif	/* REAL_ARITHMETIC */
+#endif
+#if FFETARGET_okREAL2
+#ifdef REAL_ARITHMETIC
+#ifndef __alpha__
+typedef struct
+  {
+    long int v[2];
+  }
+ffetargetReal2;
+#define ffetargetReal2_f "l"
+#define ffetarget_cvt_r2_to_rv_ REAL_VALUE_UNTO_TARGET_DOUBLE
+#define ffetarget_cvt_rv_to_r2_ REAL_VALUE_TO_TARGET_DOUBLE
+#else
+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]; \
+     _rv = REAL_VALUE_UNTO_TARGET_DOUBLE (_tmp); \
+     _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
+#else
+typedef double ffetargetReal2;
+#define ffetargetReal2_f ""
+#endif
+#endif
+#if FFETARGET_okREAL3
+#ifdef REAL_ARITHMETIC
+typedef long ffetargetReal3[?];
+#else
+typedef ? ffetargetReal3;
+#define ffetargetReal3_f
+#endif
+?
+#endif
+#if FFETARGET_okREAL4
+#ifdef REAL_ARITHMETIC
+typedef long ffetargetReal4[?];
+#else
+typedef ? ffetargetReal4;
+#define ffetargetReal4_f
+#endif
+?
+#endif
+#if FFETARGET_okREAL5
+#ifdef REAL_ARITHMETIC
+typedef long ffetargetReal5[?];
+#else
+typedef ? ffetargetReal5;
+#define ffetargetReal5_f
+#endif
+?
+#endif
+#if FFETARGET_okREAL6
+#ifdef REAL_ARITHMETIC
+typedef long ffetargetReal6[?];
+#else
+typedef ? ffetargetReal6;
+#define ffetargetReal6_f
+#endif
+?
+#endif
+#if FFETARGET_okREAL7
+#ifdef REAL_ARITHMETIC
+typedef long ffetargetReal7[?];
+#else
+typedef ? ffetargetReal7;
+#define ffetargetReal7_f
+#endif
+?
+#endif
+#if FFETARGET_okREAL8
+#ifdef REAL_ARITHMETIC
+typedef long ffetargetReal8[?];
+#else
+typedef ? ffetargetReal8;
+#define ffetargetReal8_f
+#endif
+?
+#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_okCOMPLEX4
+struct _ffetarget_complex_4_
+  {
+    ffetargetReal4 real;
+    ffetargetReal4 imaginary;
+  };
+typedef struct _ffetarget_complex_4_ ffetargetComplex4;
+#endif
+#if FFETARGET_okCOMPLEX5
+struct _ffetarget_complex_5_
+  {
+    ffetargetReal5 real;
+    ffetargetReal5 imaginary;
+  };
+typedef struct _ffetarget_complex_5_ ffetargetComplex5;
+#endif
+#if FFETARGET_okCOMPLEX6
+struct _ffetarget_complex_6_
+  {
+    ffetargetReal6 real;
+    ffetargetReal6 imaginary;
+  };
+typedef struct _ffetarget_complex_6_ ffetargetComplex6;
+#endif
+#if FFETARGET_okCOMPLEX7
+struct _ffetarget_complex_7_
+  {
+    ffetargetReal7 real;
+    ffetargetReal7 imaginary;
+  };
+typedef struct _ffetarget_complex_7_ ffetargetComplex7;
+#endif
+#if FFETARGET_okCOMPLEX8
+struct _ffetarget_complex_8_
+  {
+    ffetargetReal8 real;
+    ffetargetReal8 imaginary;
+  };
+typedef struct _ffetarget_complex_8_ ffetargetComplex8;
+#endif
+#if FFETARGET_okCHARACTER1
+struct _ffetarget_char_1_
+  {
+    ffetargetCharacterSize length;
+    unsigned char *text;
+  };
+typedef struct _ffetarget_char_1_ ffetargetCharacter1;
+typedef unsigned char ffetargetCharacterUnit1;
+#endif
+#if FFETARGET_okCHARACTER2
+typedef ? ffetargetCharacter2;
+typedef ? ffetargetCharacterUnit2;
+#endif
+#if FFETARGET_okCHARACTER3
+typedef ? ffetargetCharacter3;
+typedef ? ffetargetCharacterUnit3;
+#endif
+#if FFETARGET_okCHARACTER4
+typedef ? ffetargetCharacter4;
+typedef ? ffetargetCharacterUnit4;
+#endif
+#if FFETARGET_okCHARACTER5
+typedef ? ffetargetCharacter5;
+typedef ? ffetargetCharacterUnit5;
+#endif
+#if FFETARGET_okCHARACTER6
+typedef ? ffetargetCharacter6;
+typedef ? ffetargetCharacterUnit6;
+#endif
+#if FFETARGET_okCHARACTER7
+typedef ? ffetargetCharacter7;
+typedef ? ffetargetCharacterUnit7;
+#endif
+#if FFETARGET_okCHARACTER8
+typedef ? ffetargetCharacter8;
+typedef ? ffetargetCharacterUnit8;
+#endif
+
+typedef unsigned long long int ffetargetTypeless;
+
+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_okCOMPLEX4
+ffebad ffetarget_divide_complex4 (ffetargetComplex4 *res, ffetargetComplex4 l,
+				  ffetargetComplex4 r);
+#endif
+#if FFETARGET_okCOMPLEX5
+ffebad ffetarget_divide_complex5 (ffetargetComplex5 *res, ffetargetComplex5 l,
+				  ffetargetComplex5 r);
+#endif
+#if FFETARGET_okCOMPLEX6
+ffebad ffetarget_divide_complex6 (ffetargetComplex6 *res, ffetargetComplex6 l,
+				  ffetargetComplex6 r);
+#endif
+#if FFETARGET_okCOMPLEX7
+ffebad ffetarget_divide_complex7 (ffetargetComplex7 *res, ffetargetComplex7 l,
+				  ffetargetComplex7 r);
+#endif
+#if FFETARGET_okCOMPLEX8
+ffebad ffetarget_divide_complex8 (ffetargetComplex8 *res, ffetargetComplex8 l,
+				  ffetargetComplex8 r);
+#endif
+#if FFETARGET_okINTEGER1
+bool ffetarget_integer1 (ffetargetInteger1 *val, ffelexToken integer);
+#endif
+#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
+#if FFETARGET_okINTEGER5
+bool ffetarget_integer5 (ffetargetInteger5 *val, ffelexToken integer);
+#endif
+#if FFETARGET_okINTEGER6
+bool ffetarget_integer6 (ffetargetInteger6 *val, ffelexToken integer);
+#endif
+#if FFETARGET_okINTEGER7
+bool ffetarget_integer7 (ffetargetInteger7 *val, ffelexToken integer);
+#endif
+#if FFETARGET_okINTEGER8
+bool ffetarget_integer8 (ffetargetInteger8 *val, ffelexToken integer);
+#endif
+bool ffetarget_integerbinary (ffetargetIntegerDefault *val,
+			     ffelexToken integer);
+bool ffetarget_integerhex (ffetargetIntegerDefault *val,
+			     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 (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
+#if FFETARGET_okCOMPLEX4
+ffebad ffetarget_multiply_complex4 (ffetargetComplex4 *res,
+				    ffetargetComplex4 l,
+				    ffetargetComplex4 r);
+#endif
+#if FFETARGET_okCOMPLEX5
+ffebad ffetarget_multiply_complex5 (ffetargetComplex5 *res,
+				    ffetargetComplex5 l,
+				    ffetargetComplex5 r);
+#endif
+#if FFETARGET_okCOMPLEX6
+ffebad ffetarget_multiply_complex6 (ffetargetComplex6 *res,
+				    ffetargetComplex6 l,
+				    ffetargetComplex6 r);
+#endif
+#if FFETARGET_okCOMPLEX7
+ffebad ffetarget_multiply_complex7 (ffetargetComplex7 *res,
+				    ffetargetComplex7 l,
+				    ffetargetComplex7 r);
+#endif
+#if FFETARGET_okCOMPLEX8
+ffebad ffetarget_multiply_complex8 (ffetargetComplex8 *res,
+				    ffetargetComplex8 l,
+				    ffetargetComplex8 r);
+#endif
+ffebad ffetarget_power_complexdefault_integerdefault (ffetargetComplexDefault *res,
+						  ffetargetComplexDefault l,
+						 ffetargetIntegerDefault r);
+#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
+#if FFETARGET_okREAL4
+bool ffetarget_real4 (ffetargetReal4 *value, ffelexToken integer,
+		      ffelexToken decimal, ffelexToken fraction,
+		      ffelexToken exponent, ffelexToken exponent_sign,
+		      ffelexToken exponent_digits);
+#endif
+#if FFETARGET_okREAL5
+bool ffetarget_real5 (ffetargetReal5 *value, ffelexToken integer,
+		      ffelexToken decimal, ffelexToken fraction,
+		      ffelexToken exponent, ffelexToken exponent_sign,
+		      ffelexToken exponent_digits);
+#endif
+#if FFETARGET_okREAL6
+bool ffetarget_real6 (ffetargetReal6 *value, ffelexToken integer,
+		      ffelexToken decimal, ffelexToken fraction,
+		      ffelexToken exponent, ffelexToken exponent_sign,
+		      ffelexToken exponent_digits);
+#endif
+#if FFETARGET_okREAL7
+bool ffetarget_real7 (ffetargetReal7 *value, ffelexToken integer,
+		      ffelexToken decimal, ffelexToken fraction,
+		      ffelexToken exponent, ffelexToken exponent_sign,
+		      ffelexToken exponent_digits);
+#endif
+#if FFETARGET_okREAL8
+bool ffetarget_real8 (ffetargetReal8 *value, ffelexToken integer,
+		      ffelexToken decimal, ffelexToken fraction,
+		      ffelexToken exponent, ffelexToken exponent_sign,
+		      ffelexToken exponent_digits);
+#endif
+bool ffetarget_typeless_binary (ffetargetTypeless *value, ffelexToken token);
+bool ffetarget_typeless_octal (ffetargetTypeless *value, ffelexToken token);
+bool ffetarget_typeless_hex (ffetargetTypeless *value, ffelexToken token);
+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. */
+
+#if BUILT_FOR_280
+#define FFETARGET_REAL_VALUE_FROM_INT_(resr, lf, kt) \
+  REAL_VALUE_FROM_INT (resr, (long) lf, (long) ((lf < 0) ? -1 : 0), ((kt == 1) ? SFmode : DFmode))
+#else
+#define FFETARGET_REAL_VALUE_FROM_INT_(resr, lf, kt) \
+  REAL_VALUE_FROM_INT (resr, (long) lf, (long) ((lf < 0) ? -1 : 0))
+#endif
+
+#ifdef REAL_ARITHMETIC
+#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; })
+#else
+#define ffetarget_add_complex1(res,l,r) \
+  ((res)->real = (l).real + (r).real, \
+   (res)->imaginary = (l).imaginary + (r).imaginary, FFEBAD)
+#define ffetarget_add_complex2(res,l,r) \
+  ((res)->real = (l).real + (r).real, \
+   (res)->imaginary = (l).imaginary + (r).imaginary, FFEBAD)
+#endif
+#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)
+#ifdef REAL_ARITHMETIC
+#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; })
+#else
+#define ffetarget_add_real1(res,l,r) (*(res) = (l) + (r), FFEBAD)
+#define ffetarget_add_real2(res,l,r) (*(res) = (l) + (r), FFEBAD)
+#endif
+#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)
+#ifdef REAL_ARITHMETIC
+#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; })
+#else
+#define ffetarget_convert_complex1_complex2(res,l) \
+  ((res)->real = (l).real, (res)->imaginary = (l).imaginary, FFEBAD)
+#endif
+#ifdef REAL_ARITHMETIC
+#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; })
+#else
+#define ffetarget_convert_complex1_integer(res,l) \
+  ((res)->real = (l), (res)->imaginary = 0, FFEBAD)
+#endif
+#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 ffetarget_convert_complex1_integer
+#ifdef REAL_ARITHMETIC
+#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; })
+#else
+#define ffetarget_convert_complex1_real1(res,l) \
+  ((res)->real = (l), (res)->imaginary = 0, FFEBAD)
+#define ffetarget_convert_complex1_real2(res,l) \
+  ((res)->real = (l), (res)->imaginary = 0, FFEBAD)
+#endif
+#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)
+#ifdef REAL_ARITHMETIC
+#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; })
+#else
+#define ffetarget_convert_complex2_complex1(res,l) \
+  ((res)->real = (l).real, (res)->imaginary = (l).imaginary, FFEBAD)
+#endif
+#ifdef REAL_ARITHMETIC
+#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; })
+#else
+#define ffetarget_convert_complex2_integer(res,l) \
+  ((res)->real = (l), (res)->imaginary = 0, FFEBAD)
+#endif
+#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 ffetarget_convert_complex2_integer
+#ifdef REAL_ARITHMETIC
+#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)
+#else
+#define ffetarget_convert_complex2_real1(res,l) \
+  ((res)->real = (l), (res)->imaginary = 0, FFEBAD)
+#define ffetarget_convert_complex2_real2(res,l) \
+  ((res)->real = (l), (res)->imaginary = 0, FFEBAD)
+#endif
+#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) \
+        ffetarget_convert_integer1_complex1(res,l)
+#define ffetarget_convert_integer4_complex2(res,l) \
+        ffetarget_convert_integer1_complex2(res,l)
+#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) \
+        ffetarget_convert_integer1_real1(res,l)
+#define ffetarget_convert_integer4_real2(res,l) \
+        ffetarget_convert_integer1_real2(res,l)
+#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)
+#ifdef REAL_ARITHMETIC
+#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; })
+#else
+#define ffetarget_convert_integer1_real1(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_integer1_real2(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_integer1_complex1(res,l) (*(res) = (l).real, FFEBAD)
+#define ffetarget_convert_integer1_complex2(res,l) (*(res) = (l).real, FFEBAD)
+#endif
+#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) \
+        ffetarget_convert_real1_integer1(res,l)
+#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)
+#ifdef REAL_ARITHMETIC
+#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; })
+#else
+#define ffetarget_convert_real1_integer1(res,l) (*(res) = (l), FFEBAD)
+#endif
+#ifdef REAL_ARITHMETIC
+#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; })
+#else
+#define ffetarget_convert_real1_real2(res,l) (*(res) = (l), FFEBAD)
+#endif
+#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) \
+        ffetarget_convert_real2_integer1(res,l)
+#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)
+#ifdef REAL_ARITHMETIC
+#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
+#else
+#define ffetarget_convert_real2_integer1(res,l) (*(res) = (l), FFEBAD)
+#endif
+#ifdef REAL_ARITHMETIC
+#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; })
+#else
+#define ffetarget_convert_real2_real1(res,l) (*(res) = (l), FFEBAD)
+#endif
+#define ffetarget_divide_integer1(res,l,r) \
+  (((r) == 0) ? (*(res) = 0, FFEBAD_DIV_BY_ZERO)  \
+   : (*(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)
+#ifdef REAL_ARITHMETIC
+#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; \
+	    }); \
+	 })
+#else
+#define ffetarget_divide_real1(res,l,r) \
+  (((r) == 0) ? (*(res) = 0, FFEBAD_DIV_BY_ZERO)  \
+   : (*(res) = (l) / (r), FFEBAD))
+#define ffetarget_divide_real2(res,l,r) \
+  (((r) == 0) ? (*(res) = 0, FFEBAD_DIV_BY_ZERO)  \
+   : (*(res) = (l) / (r), FFEBAD))
+#endif
+#ifdef REAL_ARITHMETIC
+#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; })
+#else
+#define ffetarget_eq_complex1(res,l,r) \
+  (*(res) = (((l).real == (r).real) && ((l).imaginary == (r).imaginary))  \
+   ? TRUE : FALSE, FFEBAD)
+#define ffetarget_eq_complex2(res,l,r) \
+  (*(res) = (((l).real == (r).real) && ((l).imaginary == (r).imaginary))  \
+   ? TRUE : FALSE, FFEBAD)
+#endif
+#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)
+#ifdef REAL_ARITHMETIC
+#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; })
+#else
+#define ffetarget_eq_real1(res,l,r) \
+  (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_eq_real2(res,l,r) \
+  (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD)
+#endif
+#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)
+#ifdef REAL_ARITHMETIC
+#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; })
+#else
+#define ffetarget_ge_real1(res,l,r) \
+  (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_ge_real2(res,l,r) \
+  (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD)
+#endif
+#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)
+#ifdef REAL_ARITHMETIC
+#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; })
+#else
+#define ffetarget_gt_real1(res,l,r) \
+  (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_gt_real2(res,l,r) \
+  (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD)
+#endif
+#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()
+#ifndef __alpha__
+#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
+#ifdef REAL_ARITHMETIC
+#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); \
+   })
+#else
+#define ffetarget_iszero_real1(l) ((l) == 0.)
+#define ffetarget_iszero_real2(l) ((l) == 0.)
+#endif
+#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)
+#ifdef REAL_ARITHMETIC
+#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; })
+#else
+#define ffetarget_le_real1(res,l,r) \
+  (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_le_real2(res,l,r) \
+  (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD)
+#endif
+#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)
+#ifdef REAL_ARITHMETIC
+#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; })
+#else
+#define ffetarget_lt_real1(res,l,r) \
+  (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_lt_real2(res,l,r) \
+  (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD)
+#endif
+#define ffetarget_length_character1(c) ((c).length)
+#define ffetarget_length_characterdefault ffetarget_length_character1
+#ifdef REAL_ARITHMETIC
+#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]))
+#else
+#define ffetarget_make_real1(res,lr) (*(res) = (lr))
+#define ffetarget_make_real2(res,lr) (*(res) = (lr))
+#endif
+#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)
+#ifdef REAL_ARITHMETIC
+#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; })
+#else
+#define ffetarget_multiply_real1(res,l,r) (*(res) = (l) * (r), FFEBAD)
+#define ffetarget_multiply_real2(res,l,r) (*(res) = (l) * (r), FFEBAD)
+#endif
+#ifdef REAL_ARITHMETIC
+#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; })
+#else
+#define ffetarget_ne_complex1(res,l,r) \
+  (*(res) = (((l).real != (r).real) || ((l).imaginary != (r).imaginary))  \
+   ? TRUE : FALSE, FFEBAD)
+#define ffetarget_ne_complex2(res,l,r) \
+  (*(res) = (((l).real != (r).real) || ((l).imaginary != (r).imaginary))  \
+   ? TRUE : FALSE, FFEBAD)
+#endif
+#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)
+#ifdef REAL_ARITHMETIC
+#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; })
+#else
+#define ffetarget_ne_real1(res,l,r) \
+  (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_ne_real2(res,l,r) \
+  (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD)
+#endif
+#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)
+#ifdef REAL_ARITHMETIC
+#define ffetarget_print_real1(f,l) \
+  ({ REAL_VALUE_TYPE lr; \
+     lr = ffetarget_cvt_r1_to_rv_ ((l)); \
+     REAL_VALUE_TO_DECIMAL (lr, bad_fmt_val??, ffetarget_string_); \
+     fputs (ffetarget_string_, (f)); \
+   })
+#define ffetarget_print_real2(f,l) \
+  ({ REAL_VALUE_TYPE lr; \
+     lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
+     REAL_VALUE_TO_DECIMAL (lr, bad_fmt_val??, ffetarget_string_); \
+     fputs (ffetarget_string_, (f)); \
+   })
+#else
+#define ffetarget_print_real1(f,v) \
+  fprintf ((f), "%" ffetargetReal1_f "g", (v))
+#define ffetarget_print_real2(f,v) \
+  fprintf ((f), "%" ffetargetReal2_f "g", (v))
+#endif
+#ifdef REAL_ARITHMETIC
+#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]))
+#else
+#define ffetarget_real1_one(res) (*(res) = (float) 1.)
+#define ffetarget_real2_one(res) (*(res) = 1.)
+#endif
+#ifdef REAL_ARITHMETIC
+#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]))
+#else
+#define ffetarget_real1_two(res) (*(res) = (float) 2.)
+#define ffetarget_real2_two(res) (*(res) = 2.)
+#endif
+#ifdef REAL_ARITHMETIC
+#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]))
+#else
+#define ffetarget_real1_zero(res) (*(res) = (float) 0.)
+#define ffetarget_real2_zero(res) (*(res) = 0.)
+#endif
+#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)
+#ifdef REAL_ARITHMETIC
+#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; })
+#else
+#define ffetarget_subtract_complex1(res,l,r) \
+  ((res)->real = (l).real - (r).real, \
+   (res)->imaginary = (l).imaginary - (r).imaginary, FFEBAD)
+#define ffetarget_subtract_complex2(res,l,r) \
+  ((res)->real = (l).real - (r).real, \
+   (res)->imaginary = (l).imaginary - (r).imaginary, FFEBAD)
+#endif
+#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)
+#ifdef REAL_ARITHMETIC
+#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; })
+#else
+#define ffetarget_subtract_real1(res,l,r) (*(res) = (l) - (r), FFEBAD)
+#define ffetarget_subtract_real2(res,l,r) (*(res) = (l) - (r), FFEBAD)
+#endif
+#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
+#ifdef REAL_ARITHMETIC
+#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; })
+#else
+#define ffetarget_uminus_complex1(res,l) \
+  ((res)->real = -(l).real, (res)->imaginary = -(l).imaginary, FFEBAD)
+#define ffetarget_uminus_complex2(res,l) \
+  ((res)->real = -(l).real, (res)->imaginary = -(l).imaginary, FFEBAD)
+#endif
+#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)
+#ifdef REAL_ARITHMETIC
+#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; })
+#else
+#define ffetarget_uminus_real1(res,l) (*(res) = -(l), FFEBAD)
+#define ffetarget_uminus_real2(res,l) (*(res) = -(l), FFEBAD)
+#endif
+#ifdef REAL_ARITHMETIC
+#define ffetarget_value_real1(lr) ffetarget_cvt_r1_to_rv_ ((lr))
+#define ffetarget_value_real2(lr) ffetarget_cvt_r2_to_rv_ (&((lr).v[0]))
+#else
+#define ffetarget_value_real1
+#define ffetarget_value_real2
+#endif
+#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
diff --git a/gcc/f/tconfig.j b/gcc/f/tconfig.j
new file mode 100644
index 00000000000..b5fb04259c9
--- /dev/null
+++ b/gcc/f/tconfig.j
@@ -0,0 +1,27 @@
+/* tconfig.j -- Wrapper for GCC's tconfig.h
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 MAKING_DEPENDENCIES
+#ifndef _J_f_tconfig
+#define _J_f_tconfig
+#include "tconfig.h"
+#endif
+#endif
diff --git a/gcc/f/tm.j b/gcc/f/tm.j
new file mode 100644
index 00000000000..08efa5133ca
--- /dev/null
+++ b/gcc/f/tm.j
@@ -0,0 +1,27 @@
+/* tm.j -- Wrapper for GCC's tm.h
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 MAKING_DEPENDENCIES
+#ifndef _J_f_tm
+#define _J_f_tm
+#include "tm.h"
+#endif
+#endif
diff --git a/gcc/f/top.c b/gcc/f/top.c
new file mode 100644
index 00000000000..50d596ec82e
--- /dev/null
+++ b/gcc/f/top.c
@@ -0,0 +1,926 @@
+/* top.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995-1997 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 <ctype.h>
+#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 "src.h"
+#include "st.h"
+#include "storag.h"
+#include "symbol.h"
+#include "target.h"
+#include "where.h"
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#include "flags.j"
+#endif
+
+/* Externals defined here. */
+
+int flag_traditional;		/* Shouldn't need this (C front end only)! */
+bool ffe_is_do_internal_checks_ = TRUE;
+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_ = TRUE;
+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_free_form_ = FFETARGET_defaultIS_FREE_FORM;
+bool ffe_is_globals_ = TRUE;
+bool ffe_is_ident_ = 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_ (char *s);
+
+/* Internal macros. */
+
+static bool
+ffe_is_digit_string_ (char *s)
+{
+  char *p;
+
+  for (p = s; isdigit (*p); ++p)
+    ;
+
+  return (p != s) && (*p == '\0');
+}
+
+/* Handle command-line options.	 Returns 0 if unrecognized, 1 if
+   recognized and handled.  */
+
+int
+ffe_decode_option (char *opt)
+{
+  if (opt[0] != '-')
+    return 0;
+  if (opt[1] == 'f')
+    {
+      if (strcmp (&opt[2], "version") == 0)
+	ffe_set_is_version (TRUE);
+      else if (strcmp (&opt[2], "null-version") == 0)
+	;			/* Someday generate program to print version
+				   info.  */
+      else if (strcmp (&opt[2], "set-g77-defaults") == 0)
+	{
+	  ffe_is_do_internal_checks_ = 0;
+#if BUILT_FOR_270	/* User must have applied patch (circa 2.7.2 and beyond). */
+	  flag_move_all_movables = 1;
+	  flag_reduce_all_givs = 1;
+	  flag_rerun_loop_opt = 1;
+	  flag_argument_noalias = 2;
+#endif
+	}
+      else if (strcmp (&opt[2], "ident") == 0)
+	ffe_set_is_ident (TRUE);
+      else if (strcmp (&opt[2], "no-ident") == 0)
+	ffe_set_is_ident (FALSE);
+      else if (strcmp (&opt[2], "f66") == 0)
+	{
+	  ffe_set_is_onetrip (TRUE);
+	  ffe_set_is_ugly_assumed (TRUE);
+	}
+      else if (strcmp (&opt[2], "no-f66") == 0)
+	{
+	  ffe_set_is_onetrip (FALSE);
+	  ffe_set_is_ugly_assumed (FALSE);
+	}
+      else if (strcmp (&opt[2], "f77") == 0)
+	{
+	  ffe_set_is_backslash (TRUE);
+	  ffe_set_is_typeless_boz (FALSE);
+	}
+      else if (strcmp (&opt[2], "no-f77") == 0)
+	{
+	  ffe_set_is_backslash (FALSE);
+	}
+      else if (strcmp (&opt[2], "f90") == 0)
+	ffe_set_is_90 (TRUE);
+      else if (strcmp (&opt[2], "no-f90") == 0)
+	ffe_set_is_90 (FALSE);
+      else if (strcmp (&opt[2], "automatic") == 0)
+	ffe_set_is_automatic (TRUE);
+      else if (strcmp (&opt[2], "no-automatic") == 0)
+	ffe_set_is_automatic (FALSE);
+      else if (strcmp (&opt[2], "dollar-ok") == 0)
+	ffe_set_is_dollar_ok (TRUE);
+      else if (strcmp (&opt[2], "no-dollar-ok") == 0)
+	ffe_set_is_dollar_ok (FALSE);
+      else if (strcmp (&opt[2], "f2c") == 0)
+	ffe_set_is_f2c (TRUE);
+      else if (strcmp (&opt[2], "no-f2c") == 0)
+	ffe_set_is_f2c (FALSE);
+      else if (strcmp (&opt[2], "f2c-library") == 0)
+	ffe_set_is_f2c_library (TRUE);
+      else if (strcmp (&opt[2], "no-f2c-library") == 0)
+	ffe_set_is_f2c_library (FALSE);
+      else if (strcmp (&opt[2], "free-form") == 0)
+	ffe_set_is_free_form (TRUE);
+      else if (strcmp (&opt[2], "no-free-form") == 0)
+	ffe_set_is_free_form (FALSE);
+      else if (strcmp (&opt[2], "fixed-form") == 0)
+	ffe_set_is_free_form (FALSE);
+      else if (strcmp (&opt[2], "no-fixed-form") == 0)
+	ffe_set_is_free_form (TRUE);
+      else if (strcmp (&opt[2], "pedantic") == 0)
+	ffe_set_is_pedantic (TRUE);
+      else if (strcmp (&opt[2], "no-pedantic") == 0)
+	ffe_set_is_pedantic (FALSE);
+      else if (strcmp (&opt[2], "vxt") == 0)
+	ffe_set_is_vxt (TRUE);
+      else if (strcmp (&opt[2], "not-vxt") == 0)
+	ffe_set_is_vxt (FALSE);
+      else if (strcmp (&opt[2], "vxt-not-f90") == 0)
+	warning ("%s no longer supported -- try -fvxt", opt);
+      else if (strcmp (&opt[2], "f90-not-vxt") == 0)
+	warning ("%s no longer supported -- try -fno-vxt -ff90", opt);
+      else if (strcmp (&opt[2], "ugly") == 0)
+	{
+	  warning ("%s is overloaded with meanings and likely to be removed;", opt);
+	  warning ("use only the specific -fugly-* options you need");
+	  ffe_set_is_ugly_args (TRUE);
+	  ffe_set_is_ugly_assign (TRUE);
+	  ffe_set_is_ugly_assumed (TRUE);
+	  ffe_set_is_ugly_comma (TRUE);
+	  ffe_set_is_ugly_complex (TRUE);
+	  ffe_set_is_ugly_init (TRUE);
+	  ffe_set_is_ugly_logint (TRUE);
+	}
+      else if (strcmp (&opt[2], "no-ugly") == 0)
+	{
+	  ffe_set_is_ugly_args (FALSE);
+	  ffe_set_is_ugly_assign (FALSE);
+	  ffe_set_is_ugly_assumed (FALSE);
+	  ffe_set_is_ugly_comma (FALSE);
+	  ffe_set_is_ugly_complex (FALSE);
+	  ffe_set_is_ugly_init (FALSE);
+	  ffe_set_is_ugly_logint (FALSE);
+	}
+      else if (strcmp (&opt[2], "ugly-args") == 0)
+	ffe_set_is_ugly_args (TRUE);
+      else if (strcmp (&opt[2], "no-ugly-args") == 0)
+	ffe_set_is_ugly_args (FALSE);
+      else if (strcmp (&opt[2], "ugly-assign") == 0)
+	ffe_set_is_ugly_assign (TRUE);
+      else if (strcmp (&opt[2], "no-ugly-assign") == 0)
+	ffe_set_is_ugly_assign (FALSE);
+      else if (strcmp (&opt[2], "ugly-assumed") == 0)
+	ffe_set_is_ugly_assumed (TRUE);
+      else if (strcmp (&opt[2], "no-ugly-assumed") == 0)
+	ffe_set_is_ugly_assumed (FALSE);
+      else if (strcmp (&opt[2], "ugly-comma") == 0)
+	ffe_set_is_ugly_comma (TRUE);
+      else if (strcmp (&opt[2], "no-ugly-comma") == 0)
+	ffe_set_is_ugly_comma (FALSE);
+      else if (strcmp (&opt[2], "ugly-complex") == 0)
+	ffe_set_is_ugly_complex (TRUE);
+      else if (strcmp (&opt[2], "no-ugly-complex") == 0)
+	ffe_set_is_ugly_complex (FALSE);
+      else if (strcmp (&opt[2], "ugly-init") == 0)
+	ffe_set_is_ugly_init (TRUE);
+      else if (strcmp (&opt[2], "no-ugly-init") == 0)
+	ffe_set_is_ugly_init (FALSE);
+      else if (strcmp (&opt[2], "ugly-logint") == 0)
+	ffe_set_is_ugly_logint (TRUE);
+      else if (strcmp (&opt[2], "no-ugly-logint") == 0)
+	ffe_set_is_ugly_logint (FALSE);
+      else if (strcmp (&opt[2], "xyzzy") == 0)
+	ffe_set_is_ffedebug (TRUE);
+      else if (strcmp (&opt[2], "no-xyzzy") == 0)
+	ffe_set_is_ffedebug (FALSE);
+      else if (strcmp (&opt[2], "init-local-zero") == 0)
+	ffe_set_is_init_local_zero (TRUE);
+      else if (strcmp (&opt[2], "no-init-local-zero") == 0)
+	ffe_set_is_init_local_zero (FALSE);
+      else if (strcmp (&opt[2], "emulate-complex") == 0)
+	ffe_set_is_emulate_complex (TRUE);
+      else if (strcmp (&opt[2], "no-emulate-complex") == 0)
+	ffe_set_is_emulate_complex (FALSE);
+      else if (strcmp (&opt[2], "backslash") == 0)
+	ffe_set_is_backslash (TRUE);
+      else if (strcmp (&opt[2], "no-backslash") == 0)
+	ffe_set_is_backslash (FALSE);
+      else if (strcmp (&opt[2], "underscoring") == 0)
+	ffe_set_is_underscoring (TRUE);
+      else if (strcmp (&opt[2], "no-underscoring") == 0)
+	ffe_set_is_underscoring (FALSE);
+      else if (strcmp (&opt[2], "second-underscore") == 0)
+	ffe_set_is_second_underscore (TRUE);
+      else if (strcmp (&opt[2], "no-second-underscore") == 0)
+	ffe_set_is_second_underscore (FALSE);
+      else if (strcmp (&opt[2], "zeros") == 0)
+	ffe_set_is_zeros (TRUE);
+      else if (strcmp (&opt[2], "no-zeros") == 0)
+	ffe_set_is_zeros (FALSE);
+      else if (strcmp (&opt[2], "debug-kludge") == 0)
+	ffe_set_is_debug_kludge (TRUE);
+      else if (strcmp (&opt[2], "no-debug-kludge") == 0)
+	ffe_set_is_debug_kludge (FALSE);
+      else if (strcmp (&opt[2], "onetrip") == 0)
+	ffe_set_is_onetrip (TRUE);
+      else if (strcmp (&opt[2], "no-onetrip") == 0)
+	ffe_set_is_onetrip (FALSE);
+      else if (strcmp (&opt[2], "silent") == 0)
+	ffe_set_is_silent (TRUE);
+      else if (strcmp (&opt[2], "no-silent") == 0)
+	ffe_set_is_silent (FALSE);
+      else if (strcmp (&opt[2], "globals") == 0)
+	ffe_set_is_globals (TRUE);
+      else if (strcmp (&opt[2], "no-globals") == 0)
+	ffe_set_is_globals (FALSE);
+      else if (strcmp (&opt[2], "typeless-boz") == 0)
+	ffe_set_is_typeless_boz (TRUE);
+      else if (strcmp (&opt[2], "no-typeless-boz") == 0)
+	ffe_set_is_typeless_boz (FALSE);
+      else if (strcmp (&opt[2], "intrin-case-initcap") == 0)
+	ffe_set_case_intrin (FFE_caseINITCAP);
+      else if (strcmp (&opt[2], "intrin-case-upper") == 0)
+	ffe_set_case_intrin (FFE_caseUPPER);
+      else if (strcmp (&opt[2], "intrin-case-lower") == 0)
+	ffe_set_case_intrin (FFE_caseLOWER);
+      else if (strcmp (&opt[2], "intrin-case-any") == 0)
+	ffe_set_case_intrin (FFE_caseNONE);
+      else if (strcmp (&opt[2], "match-case-initcap") == 0)
+	ffe_set_case_match (FFE_caseINITCAP);
+      else if (strcmp (&opt[2], "match-case-upper") == 0)
+	ffe_set_case_match (FFE_caseUPPER);
+      else if (strcmp (&opt[2], "match-case-lower") == 0)
+	ffe_set_case_match (FFE_caseLOWER);
+      else if (strcmp (&opt[2], "match-case-any") == 0)
+	ffe_set_case_match (FFE_caseNONE);
+      else if (strcmp (&opt[2], "source-case-upper") == 0)
+	ffe_set_case_source (FFE_caseUPPER);
+      else if (strcmp (&opt[2], "source-case-lower") == 0)
+	ffe_set_case_source (FFE_caseLOWER);
+      else if (strcmp (&opt[2], "source-case-preserve") == 0)
+	ffe_set_case_source (FFE_caseNONE);
+      else if (strcmp (&opt[2], "symbol-case-initcap") == 0)
+	ffe_set_case_symbol (FFE_caseINITCAP);
+      else if (strcmp (&opt[2], "symbol-case-upper") == 0)
+	ffe_set_case_symbol (FFE_caseUPPER);
+      else if (strcmp (&opt[2], "symbol-case-lower") == 0)
+	ffe_set_case_symbol (FFE_caseLOWER);
+      else if (strcmp (&opt[2], "symbol-case-any") == 0)
+	ffe_set_case_symbol (FFE_caseNONE);
+      else if (strcmp (&opt[2], "case-strict-upper") == 0)
+	{
+	  ffe_set_case_intrin (FFE_caseUPPER);
+	  ffe_set_case_match (FFE_caseUPPER);
+	  ffe_set_case_source (FFE_caseNONE);
+	  ffe_set_case_symbol (FFE_caseUPPER);
+	}
+      else if (strcmp (&opt[2], "case-strict-lower") == 0)
+	{
+	  ffe_set_case_intrin (FFE_caseLOWER);
+	  ffe_set_case_match (FFE_caseLOWER);
+	  ffe_set_case_source (FFE_caseNONE);
+	  ffe_set_case_symbol (FFE_caseLOWER);
+	}
+      else if (strcmp (&opt[2], "case-initcap") == 0)
+	{
+	  ffe_set_case_intrin (FFE_caseINITCAP);
+	  ffe_set_case_match (FFE_caseINITCAP);
+	  ffe_set_case_source (FFE_caseNONE);
+	  ffe_set_case_symbol (FFE_caseINITCAP);
+	}
+      else if (strcmp (&opt[2], "case-upper") == 0)
+	{
+	  ffe_set_case_intrin (FFE_caseNONE);
+	  ffe_set_case_match (FFE_caseNONE);
+	  ffe_set_case_source (FFE_caseUPPER);
+	  ffe_set_case_symbol (FFE_caseNONE);
+	}
+      else if (strcmp (&opt[2], "case-lower") == 0)
+	{
+	  ffe_set_case_intrin (FFE_caseNONE);
+	  ffe_set_case_match (FFE_caseNONE);
+	  ffe_set_case_source (FFE_caseLOWER);
+	  ffe_set_case_symbol (FFE_caseNONE);
+	}
+      else if (strcmp (&opt[2], "case-preserve") == 0)
+	{
+	  ffe_set_case_intrin (FFE_caseNONE);
+	  ffe_set_case_match (FFE_caseNONE);
+	  ffe_set_case_source (FFE_caseNONE);
+	  ffe_set_case_symbol (FFE_caseNONE);
+	}
+      else if (strcmp (&opt[2], "badu77-intrinsics-delete") == 0)
+	ffe_set_intrinsic_state_badu77 (FFE_intrinsicstateDELETED);
+      else if (strcmp (&opt[2], "badu77-intrinsics-hide") == 0)
+	ffe_set_intrinsic_state_badu77 (FFE_intrinsicstateHIDDEN);
+      else if (strcmp (&opt[2], "badu77-intrinsics-disable") == 0)
+	ffe_set_intrinsic_state_badu77 (FFE_intrinsicstateDISABLED);
+      else if (strcmp (&opt[2], "badu77-intrinsics-enable") == 0)
+	ffe_set_intrinsic_state_badu77 (FFE_intrinsicstateENABLED);
+      else if (strcmp (&opt[2], "gnu-intrinsics-delete") == 0)
+	ffe_set_intrinsic_state_gnu (FFE_intrinsicstateDELETED);
+      else if (strcmp (&opt[2], "gnu-intrinsics-hide") == 0)
+	ffe_set_intrinsic_state_gnu (FFE_intrinsicstateHIDDEN);
+      else if (strcmp (&opt[2], "gnu-intrinsics-disable") == 0)
+	ffe_set_intrinsic_state_gnu (FFE_intrinsicstateDISABLED);
+      else if (strcmp (&opt[2], "gnu-intrinsics-enable") == 0)
+	ffe_set_intrinsic_state_gnu (FFE_intrinsicstateENABLED);
+      else if (strcmp (&opt[2], "f2c-intrinsics-delete") == 0)
+	ffe_set_intrinsic_state_f2c (FFE_intrinsicstateDELETED);
+      else if (strcmp (&opt[2], "f2c-intrinsics-hide") == 0)
+	ffe_set_intrinsic_state_f2c (FFE_intrinsicstateHIDDEN);
+      else if (strcmp (&opt[2], "f2c-intrinsics-disable") == 0)
+	ffe_set_intrinsic_state_f2c (FFE_intrinsicstateDISABLED);
+      else if (strcmp (&opt[2], "f2c-intrinsics-enable") == 0)
+	ffe_set_intrinsic_state_f2c (FFE_intrinsicstateENABLED);
+      else if (strcmp (&opt[2], "f90-intrinsics-delete") == 0)
+	ffe_set_intrinsic_state_f90 (FFE_intrinsicstateDELETED);
+      else if (strcmp (&opt[2], "f90-intrinsics-hide") == 0)
+	ffe_set_intrinsic_state_f90 (FFE_intrinsicstateHIDDEN);
+      else if (strcmp (&opt[2], "f90-intrinsics-disable") == 0)
+	ffe_set_intrinsic_state_f90 (FFE_intrinsicstateDISABLED);
+      else if (strcmp (&opt[2], "f90-intrinsics-enable") == 0)
+	ffe_set_intrinsic_state_f90 (FFE_intrinsicstateENABLED);
+      else if (strcmp (&opt[2], "mil-intrinsics-delete") == 0)
+	ffe_set_intrinsic_state_mil (FFE_intrinsicstateDELETED);
+      else if (strcmp (&opt[2], "mil-intrinsics-hide") == 0)
+	ffe_set_intrinsic_state_mil (FFE_intrinsicstateHIDDEN);
+      else if (strcmp (&opt[2], "mil-intrinsics-disable") == 0)
+	ffe_set_intrinsic_state_mil (FFE_intrinsicstateDISABLED);
+      else if (strcmp (&opt[2], "mil-intrinsics-enable") == 0)
+	ffe_set_intrinsic_state_mil (FFE_intrinsicstateENABLED);
+      else if (strcmp (&opt[2], "unix-intrinsics-delete") == 0)
+	ffe_set_intrinsic_state_unix (FFE_intrinsicstateDELETED);
+      else if (strcmp (&opt[2], "unix-intrinsics-hide") == 0)
+	ffe_set_intrinsic_state_unix (FFE_intrinsicstateHIDDEN);
+      else if (strcmp (&opt[2], "unix-intrinsics-disable") == 0)
+	ffe_set_intrinsic_state_unix (FFE_intrinsicstateDISABLED);
+      else if (strcmp (&opt[2], "unix-intrinsics-enable") == 0)
+	ffe_set_intrinsic_state_unix (FFE_intrinsicstateENABLED);
+      else if (strcmp (&opt[2], "vxt-intrinsics-delete") == 0)
+	ffe_set_intrinsic_state_vxt (FFE_intrinsicstateDELETED);
+      else if (strcmp (&opt[2], "vxt-intrinsics-hide") == 0)
+	ffe_set_intrinsic_state_vxt (FFE_intrinsicstateHIDDEN);
+      else if (strcmp (&opt[2], "vxt-intrinsics-disable") == 0)
+	ffe_set_intrinsic_state_vxt (FFE_intrinsicstateDISABLED);
+      else if (strcmp (&opt[2], "vxt-intrinsics-enable") == 0)
+	ffe_set_intrinsic_state_vxt (FFE_intrinsicstateENABLED);
+      else if (strncmp (&opt[2], "fixed-line-length-",
+			strlen ("fixed-line-length-")) == 0)
+	{
+	  char *len = &opt[2] + strlen ("fixed-line-length-");
+
+	  if (strcmp (len, "none") == 0)
+	    ffe_set_fixed_line_length (0);
+	  else if (ffe_is_digit_string_ (len))
+	    ffe_set_fixed_line_length (atol (len));
+	  else
+	    return 0;
+	}
+      else
+	return 0;
+    }
+  else if (opt[1] == 'W')
+    {
+      if (!strcmp (&opt[2], "comment"))
+	; /* cpp handles this one.  */
+      else if (!strcmp (&opt[2], "no-comment"))
+	; /* cpp handles this one.  */
+      else if (!strcmp (&opt[2], "comments"))
+	; /* cpp handles this one.  */
+      else if (!strcmp (&opt[2], "no-comments"))
+	; /* cpp handles this one.  */
+      else if (!strcmp (&opt[2], "trigraphs"))
+	; /* cpp handles this one.  */
+      else if (!strcmp (&opt[2], "no-trigraphs"))
+	; /* cpp handles this one.  */
+      else if (!strcmp (&opt[2], "import"))
+	; /* cpp handles this one.  */
+      else if (!strcmp (&opt[2], "no-import"))
+	; /* cpp handles this one.  */
+      else if (!strcmp (&opt[2], "globals"))
+	ffe_set_is_warn_globals (TRUE);
+      else if (!strcmp (&opt[2], "no-globals"))
+	ffe_set_is_warn_globals (FALSE);
+      else if (!strcmp (&opt[2], "implicit"))
+	ffe_set_is_warn_implicit (TRUE);
+      else if (!strcmp (&opt[2], "no-implicit"))
+	ffe_set_is_warn_implicit (FALSE);
+      else if (!strcmp (&opt[2], "surprising"))
+	ffe_set_is_warn_surprising (TRUE);
+      else if (!strcmp (&opt[2], "no-surprising"))
+	ffe_set_is_warn_surprising (FALSE);
+      else if (!strcmp (&opt[2], "all"))
+	{
+	  /* We save the value of warn_uninitialized, since if they put
+	     -Wuninitialized on the command line, we need to generate a
+	     warning about not using it without also specifying -O.  */
+	  if (warn_uninitialized != 1)
+	    warn_uninitialized = 2;
+	  warn_unused = 1;
+	}
+      else
+	return 0;
+    }
+  else if (opt[1] == 'I')
+    return ffecom_decode_include_option (&opt[2]);
+  else
+    return 0;
+
+  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 ()
+{
+  ++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 ()
+{
+  ++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 ()
+{
+  ++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 ()
+{
+  ++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 ()
+{
+  ++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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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 ()
+{
+  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
new file mode 100644
index 00000000000..3d91fd77be7
--- /dev/null
+++ b/gcc/f/top.h
@@ -0,0 +1,261 @@
+/* top.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995-1997 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_parse
+#define _H_f_parse
+
+/* 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_free_form_;
+extern bool ffe_is_globals_;
+extern bool ffe_is_ident_;
+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. */
+
+int ffe_decode_option (char *opt);
+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_free_form() ffe_is_free_form_
+#define ffe_is_globals() ffe_is_globals_
+#define ffe_is_ident() ffe_is_ident_
+#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_set_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_free_form(f) (ffe_is_free_form_ = (f))
+#define ffe_set_is_globals(f) (ffe_is_globals_ = (f))
+#define ffe_set_is_ident(f) (ffe_is_ident_ = (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
diff --git a/gcc/f/tree.j b/gcc/f/tree.j
new file mode 100644
index 00000000000..3b836b32819
--- /dev/null
+++ b/gcc/f/tree.j
@@ -0,0 +1,28 @@
+/* tree.j -- Wrapper for GCC's tree.h
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 MAKING_DEPENDENCIES
+#ifndef _J_f_tree
+#define _J_f_tree
+#include "config.j"
+#include "tree.h"
+#endif
+#endif
diff --git a/gcc/f/type.c b/gcc/f/type.c
new file mode 100644
index 00000000000..f359362849f
--- /dev/null
+++ b/gcc/f/type.c
@@ -0,0 +1,107 @@
+/* Implementation of Fortran type abstraction
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 = (ffetype) 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_
+	= (ffetype_indexes_) 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_
+	= (ffetype_indexes_) 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
new file mode 100644
index 00000000000..a89364fa4b9
--- /dev/null
+++ b/gcc/f/type.h
@@ -0,0 +1,64 @@
+/* Interface definitions for Fortran type abstraction
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_type
+#define _H_f_type
+
+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
diff --git a/gcc/f/where.c b/gcc/f/where.c
new file mode 100644
index 00000000000..7442a5fac3a
--- /dev/null
+++ b/gcc/f/where.c
@@ -0,0 +1,542 @@
+/* where.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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"
+
+/* Externals defined here. */
+
+struct _ffewhere_line_ ffewhere_unknown_line_
+=
+{NULL, NULL, 0, 0, 0};
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+typedef struct _ffewhere_ll_ *ffewhereLL_;
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+struct _ffewhere_ll_
+  {
+    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_
+  {
+    ffewhereLL_ first;
+    ffewhereLL_ last;
+  };
+
+struct _ffewhere_root_line_
+  {
+    ffewhereLine first;
+    ffewhereLine last;
+    ffewhereLineNumber none;
+  };
+
+/* Static objects accessed by functions in this module. */
+
+static 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;
+}
+
+/* Kill file object.
+
+   Note that this object must not have been passed in a call
+   to any other ffewhere function except ffewhere_file_name and
+   ffewhere_file_namelen.  */
+
+void
+ffewhere_file_kill (ffewhereFile wf)
+{
+  malloc_kill_ks (ffe_pool_file (), wf,
+		  offsetof (struct _ffewhere_file_, text)
+		  + wf->length + 1);
+}
+
+/* Create file object.  */
+
+ffewhereFile
+ffewhere_file_new (char *name, size_t length)
+{
+  ffewhereFile wf;
+
+  wf = malloc_new_ks (ffe_pool_file (), "ffewhereFile",
+		      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 = malloc_new_kp (ffe_pool_file (), "ffewhereLL_", 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 ()
+{
+  ffewhere_root_line_.first = ffewhere_root_line_.last
+  = (ffewhereLine) &ffewhere_root_line_.first;
+  ffewhere_root_line_.none = 0;
+
+  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;
+      if (cn > FFEWHERE_indexUNKNOWN)
+	{
+	  wt[i * 2 - 1] = FFEWHERE_indexUNKNOWN;
+	  ffewhere_line_kill (*wl);
+	  ffewhere_column_kill (*wc);
+	  *wl = ffewhere_line_unknown ();
+	  *wc = ffewhere_column_unknown ();
+	}
+      else
+	{
+	  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);
+	}
+    }
+}
diff --git a/gcc/f/where.h b/gcc/f/where.h
new file mode 100644
index 00000000000..aae031367d2
--- /dev/null
+++ b/gcc/f/where.h
@@ -0,0 +1,138 @@
+/* where.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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 _H_f_where
+#define _H_f_where
+
+/* 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 "glimits.j"
+#include "top.h"
+
+/* Structure definitions. */
+
+struct _ffewhere_file_
+  {
+    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. */
+
+void ffewhere_file_kill (ffewhereFile wf);
+ffewhereFile ffewhere_file_new (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
diff --git a/gcc/f/zzz.c b/gcc/f/zzz.c
new file mode 100644
index 00000000000..cff8e54143f
--- /dev/null
+++ b/gcc/f/zzz.c
@@ -0,0 +1,56 @@
+/* zzz.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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:
+      Has the version number for the front end.	 Makes it easier to
+      tell how consistently patches have been applied, etc.
+
+   Modifications:
+*/
+
+#include "zzz.h"
+
+/* If you want to override the version date/time info with your own
+   macros, e.g. for a consistent distribution when bootstrapping,
+   go ahead!  */
+
+#ifndef FFEZZZ_DATE
+#ifdef __DATE__
+#define FFEZZZ_DATE __DATE__
+#else	/* !defined (__DATE__) */
+#define FFEZZZ_DATE "date unknown"
+#endif	/* !defined (__DATE__) */
+#endif	/* !defined (FFEZZZ_DATE) */
+
+#ifndef FFEZZZ_TIME
+#ifdef __TIME__
+#define FFEZZZ_TIME __TIME__
+#else	/* !defined (__TIME__) */
+#define FFEZZZ_TIME "time unknown"
+#endif	/* !defined (__TIME__) */
+#endif	/* !defined (FFEZZZ_TIME) */
+
+char *ffezzz_version_string = "0.5.21-19970811";
+char *ffezzz_date = FFEZZZ_DATE;
+char *ffezzz_time = FFEZZZ_TIME;
diff --git a/gcc/f/zzz.h b/gcc/f/zzz.h
new file mode 100644
index 00000000000..9414f97f43e
--- /dev/null
+++ b/gcc/f/zzz.h
@@ -0,0 +1,35 @@
+/* zzz.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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:
+      zzz.c
+
+   Modifications:
+*/
+
+#ifndef _H_f_zzz
+#define _H_f_zzz
+
+extern char *ffezzz_version_string;
+extern char *ffezzz_date;
+extern char *ffezzz_time;
+
+#endif