rewrite to use block/scope structure of GBE

From-SVN: r26515

13 files changed, 3844 insertions, 2736 deletions

diff --git a/gcc/f/ChangeLog b/gcc/f/ChangeLog
index 9d2f134..8d07c01 100644
--- a/gcc/f/ChangeLog
+++ b/gcc/f/ChangeLog
@@ -1,3 +1,112 @@
+Sat Apr 17 13:53:43 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Rewrite to use block/scope structure of GBE and to ensure
+	variables (especially those going on stack/reg) are declared
+	before executable code generated:
+	* bld.c (ffebld_new_item, ffebld_new_one, ffebld_new_two):
+	Support new hooks.
+	* bld.h (ffebld_item_hook, ffebld_item_set_hook,
+	ffebld_nonter_hook, ffebld_nonter_set_hook): Ditto.
+	* bld.h (ffebld_basictype, ffebld_kind, ffebld_kindtype,
+	ffebld_rank, ffebld_where): New convenience macros (used
+	by rest of this patch).
+	* com.c, com.h (ffecom_push_calltemps, ffecom_pop_calltemps,
+	ffecom_push_tempvar, ffecom_pop_tempvar): Remove temp-var-
+	handling mechanism.
+	* com.c (ffecom_call_, ffecom_call_binop_, ffecom_tree_divide_,
+	ffecom_call_gfrt): Support passing hooks for temp-var info.
+	(ffecom_expr_power_integer_): Takes opPOWER expression, instead
+	of its left and right operands, so it can get at the hook.
+	(ffecom_prepare_let_char_, ffecom_prepare_arg_ptr_to_expr,
+	ffecom_prepare_end, ffecom_prepare_expr_, ffecom_prepare_expr_rw,
+	ffecom_prepare_expr_w, ffecom_prepare_return_expr,
+	ffecom_prepare_ptr_to_expr): New functions supporting expression
+	pre-scanning.
+	(bison_rule_compstmt_): Return the tree, as in the CFE.
+	(delete_block): New function, from CFE.
+	(kept_level_p): New function, from CFE, modified.
+	(ffecom_start_compstmt, ffecom_end_compstmt): New functions,
+	replacing ffecom_start_compstmt_ and ffecom_end_compstmt_ macros,
+	and they do real work.
+	(struct binding_level): Add prep_state member.  Initialize to 0.
+	(ffecom_get_invented_identifier): Now takes either or both a
+	string and an integer, using -1 to denote no integer.
+	(ffecom_do_entry_): Disallow temp-var generation via expressions
+	in body of function, since the exprs aren't prescanned.
+	(ffecom_expr_rw): Now takes destination tree.
+	(ffecom_expr_w): New function, now used in some places
+	ffecom_expr_rw had been used.
+	(ffecom_expr_intrinsic_): Move huge f2c-related comment to bottom
+	of source file, to avoid annoying problems editing com.c using
+	Emacs C-mode.
+	(ffecom_expr_power_integer_): Make a temp var for division, if
+	necessary.
+	Handle expanded statement expression as does CFE.
+	(ffecom_start_progunit_): Disallow temp-var generation in body
+	of function, since expressions are not prescanned at this level.
+	(ffecom_sym_transform_): Transform ASSIGN variables as well,
+	so these are all transformed up front, before code-generation
+	begins.
+	(ffecom_arg_ptr_to_const_expr, ffecom_const_expr,
+	ffecom_ptr_to_const_expr): New functions to transform expressions
+	only if the results will surely be constants.
+	(ffecom_arg_ptr_to_expr): Precompute size, for convenience
+	obtaining temp vars.
+	(ffecom_expand_let_stmt): Guess at usability of destination
+	pre-expansion, to provide better prescan preparation (fewer
+	spurious temp vars).
+	(ffecom_init_0): Disallow temp-var generation in global scope.
+	(ffecom_type_expr): New function, returns just the type tree
+	for the expression.
+	(start_function): Disallow temp-var generation in parm scope.
+	(incomplete_type_error): Fix introductory comment.
+	(poplevel): Update (somewhat) from CFE.
+	(pushlevel): Update (somewhat) from CFE.
+	* stc.c (ffestc_R838): Mark ASSIGNed variable as so.
+	* std.c (ffestd_stmt_pass_, ffestd_R803, ffestd_R804, ffestd_R805,
+	ffestd_R806): Remember and pass through the ffestw block info
+	for these (IFTHEN, ELSEIF, ELSE, and ENDIF) statements.
+	* ste.c (ffeste_end_iterdo_): Now takes ffestw block argument.
+	(ffeste_io_inlist_): Add prototype.
+	(ffeste_f2c_*): Macros rewritten, new ones added.
+	(ffeste_start_block_, ffeste_end_block_, ffeste_start_stmt_,
+	ffeste_end_stmt_): New macros/functions, depending on whether
+	checking is enabled, to keep track of symmetry of other ste.c code.
+	(ffeste_begin_iterdo_, ffeste_end_iterdo_, ffeste_io_impdo_,
+	ffeste_io_dofio_, ffeste_io_dolio_, ffeste_io_douio_,
+	ffeste_io_ialist_, ffeste_io_cilist_, ffeste_io_cllist_,
+	ffeste_icilist_, ffeste_io_inlist_, ffeste_io_olist_,
+	ffeste_subr_beru_, ffeste_do, ffeste_end_R807, ffeste_R737A,
+	ffeste_R803, ffeste_R804, ffeste_R805, ffeste_R806, ffeste_R807,
+	ffeste_R809, ffeste_R810, ffeste_R811, ffeste_R819A, ffeste_R819B,
+	ffeste_R837, ffeste_R838, ffeste_R839, ffeste_R840, ffeste_R904,
+	ffeste_R907, ffeste_R909_start, ffeste_R909_item, ffeste_R909_finish,
+	ffeste_R910_start, ffeste_R910_item, ffeste_R910_finish,
+	ffeste_R911_start, ffeste_R911_item, ffeste_R911_finish,
+	ffeste_R923A, ffeste_R1212, ffeste_R1227): Prescan/prepare
+	all pertinent expressions, update to new com.c interface, etc.
+	(ffeste_io_impdo_): Relocate.
+	(ffeste_R834, ffeste_R835, ffeste_R836, ffeste_R1226): Don't
+	bother calling clear_momentary, nothing was generated.
+	(ffeste_R842, ffeste_R843): Update to new com.c interface.
+	(ffeste_R1226): Don't try to stuff error_mark_node's DECL_INITIAL.
+	(ffeste_terminate_2): When checking enabled, make sure all blocks
+	and statements have been ended.
+	* ste.h (ffeste_R803, ffeste_R804, ffeste_R805, ffeste_R806):
+	These now take ffestw block argument.
+	(ffeste_terminate_2): When checking enabled, it's a function, not
+	a macro.
+	* stw.h (struct _ffestw_): New variable for IFTHEN.
+	(ffestw_ifthen_fake_else, ffestw_set_ifthen_fake_else): New
+	accessor macros.
+	* symbol.c, symbol.h: Support new ASSIGN'ed-to info.
+
+	* com.c: Clean up commentary per GNU coding standards.
+
+	* bld.h (ffebld_size, ffebld_size_known): Canonize.
+
+	* version.c: Bump version.
+
 Sun Apr 11 21:33:33 1999  Mumit Khan  <khan@xraylith.wisc.edu>
 
 	* g77spec.c (lang_specific_driver): Check whether MATH_LIBRARY is
diff --git a/gcc/f/bld.c b/gcc/f/bld.c
index 6ef559e..15cadf1 100644
--- a/gcc/f/bld.c
+++ b/gcc/f/bld.c
@@ -5573,6 +5573,9 @@ ffebld_new_item (ffebld head, ffebld trail)
   x->op = FFEBLD_opITEM;
   x->u.item.head = head;
   x->u.item.trail = trail;
+#ifdef FFECOM_itemHOOK
+  x->u.item.hook = FFECOM_itemNULL;
+#endif
   return x;
 }
 
@@ -5655,6 +5658,9 @@ ffebld_new_one (ffebldOp o, ffebld left)
 #endif
   x->op = o;
   x->u.nonter.left = left;
+#ifdef FFECOM_nonterHOOK
+  x->u.nonter.hook = FFECOM_nonterNULL;
+#endif
   return x;
 }
 
@@ -5703,6 +5709,9 @@ ffebld_new_two (ffebldOp o, ffebld left, ffebld right)
   x->op = o;
   x->u.nonter.left = left;
   x->u.nonter.right = right;
+#ifdef FFECOM_nonterHOOK
+  x->u.nonter.hook = FFECOM_nonterNULL;
+#endif
   return x;
 }
 
diff --git a/gcc/f/bld.h b/gcc/f/bld.h
index 96c8e5e..ddbd448 100644
--- a/gcc/f/bld.h
+++ b/gcc/f/bld.h
@@ -406,12 +406,18 @@ struct _ffebld_
 	  {
 	    ffebld left;
 	    ffebld right;
+#ifdef FFECOM_nonterHOOK
+	    ffecomNonter hook;	/* Whatever the compiler/backend wants! */
+#endif
 	  }
 	nonter;
 	struct
 	  {
 	    ffebld head;
 	    ffebld trail;
+#ifdef FFECOM_itemHOOK
+	    ffecomItem hook;	/* Whatever the compiler/backend wants! */
+#endif
 	  }
 	item;
 	struct
@@ -748,6 +754,7 @@ ffetargetCharacterSize ffebld_size_max (ffebld b);
 #define ffebld_arrter_set_pad(b,p) ((b)->u.arrter.pad = (p))
 #define ffebld_arrter_set_size(b,s) ((b)->u.arrter.size = (s))
 #define ffebld_arrter_size(b) ((b)->u.arrter.size)
+#define ffebld_basictype(b) (ffeinfo_basictype (ffebld_info ((b))))
 #if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstPROGUNIT_
 #define ffebld_constant_pool() ffe_pool_program_unit()
 #elif FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstFILE_
@@ -944,6 +951,10 @@ ffetargetCharacterSize ffebld_size_max (ffebld b);
 #define ffebld_init_3()
 #define ffebld_init_4()
 #define ffebld_init_list(l,b) (*(l) = NULL, *(b) = (l))
+#define ffebld_item_hook(b) ((b)->u.item.hook)
+#define ffebld_item_set_hook(b,h) ((b)->u.item.hook = (h))
+#define ffebld_kind(b) (ffeinfo_kind (ffebld_info ((b))))
+#define ffebld_kindtype(b) (ffeinfo_kindtype (ffebld_info ((b))))
 #define ffebld_labter(b) ((b)->u.labter)
 #define ffebld_labtok(b) ((b)->u.labtok)
 #define ffebld_left(b) ((b)->u.nonter.left)
@@ -987,8 +998,11 @@ ffetargetCharacterSize ffebld_size_max (ffebld b);
 #define ffebld_new_arrayref(l,r) ffebld_new_two(FFEBLD_opARRAYREF,(l),(r))
 #define ffebld_new_substr(l,r) ffebld_new_two(FFEBLD_opSUBSTR,(l),(r))
 #define ffebld_new_impdo(l,r) ffebld_new_two(FFEBLD_opIMPDO,(l),(r))
+#define ffebld_nonter_hook(b) ((b)->u.nonter.hook)
+#define ffebld_nonter_set_hook(b,h) ((b)->u.nonter.hook = (h))
 #define ffebld_op(b) ((b)->op)
 #define ffebld_pool() (ffebld_pool_stack_.pool)
+#define ffebld_rank(b) (ffeinfo_rank (ffebld_info ((b))))
 #define ffebld_right(b) ((b)->u.nonter.right)
 #define ffebld_set_accter(b,a) ((b)->u.accter.array = (a))
 #define ffebld_set_arrter(b,a) ((b)->u.arrter.array = (a))
@@ -1000,8 +1014,8 @@ ffetargetCharacterSize ffebld_size_max (ffebld b);
 #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_size(b) (ffeinfo_size (ffebld_info ((b))))
+#define ffebld_size_known(b) ffebld_size((b))
 #define ffebld_symter(b) ((b)->u.symter.symbol)
 #define ffebld_symter_generic(b) ((b)->u.symter.generic)
 #define ffebld_symter_doiter(b) ((b)->u.symter.do_iter)
@@ -1018,6 +1032,7 @@ ffetargetCharacterSize ffebld_size_max (ffebld b);
 #define ffebld_terminate_3()
 #define ffebld_terminate_4()
 #define ffebld_trail(b) ((b)->u.item.trail)
+#define ffebld_where(b) (ffeinfo_where (ffebld_info ((b))))
 
 /* End of #include file. */
 
diff --git a/gcc/f/com.c b/gcc/f/com.c
index dabf049..1d7676d 100644
--- a/gcc/f/com.c
+++ b/gcc/f/com.c
@@ -60,9 +60,9 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 		   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_ ();
+   ffecom_start_compstmt ();
    // for stmts and decls inside function, do appropriate things;
-   ffecom_end_compstmt_ ();
+   ffecom_end_compstmt ();
    finish_function (is_nested);
    if (is_nested) pop_f_function_context ();
    if (is_nested) resume_momentary (yes);
@@ -231,8 +231,8 @@ 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.  */
+/* ~~gcc/tree.h *should* declare this, because toplev.c and dwarfout.c
+   reference it.  */
 
 char *language_string = "GNU F77";
 
@@ -369,7 +369,6 @@ typedef enum
 
 #if FFECOM_targetCURRENT == FFECOM_targetGCC
 typedef struct _ffecom_concat_list_ ffecomConcatList_;
-typedef struct _ffecom_temp_ *ffecomTemp_;
 #endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
 
 /* Private include files. */
@@ -386,18 +385,6 @@ struct _ffecom_concat_list_
     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). */
@@ -416,13 +403,13 @@ 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 callee_commons, bool scalar_args, tree hook);
 static tree ffecom_call_binop_ (tree fn, ffeinfoKindtype kt,
 				bool is_f2c_complex, tree type,
 				ffebld left, ffebld right,
 				tree dest_tree, ffebld dest,
 				bool *dest_used, tree callee_commons,
-				bool scalar_args);
+				bool scalar_args, tree hook);
 static void ffecom_char_args_x_ (tree *xitem, tree *length,
 				 ffebld expr, bool with_null);
 static tree ffecom_check_size_overflow_ (ffesymbol s, tree type, bool dummy);
@@ -442,7 +429,7 @@ static tree ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
 			  bool *dest_used, bool assignp, bool widenp);
 static tree ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 				    ffebld dest, bool *dest_used);
-static tree ffecom_expr_power_integer_ (ffebld left, ffebld right);
+static tree ffecom_expr_power_integer_ (ffebld expr);
 static void ffecom_expr_transform_ (ffebld expr);
 static void ffecom_f2c_make_type_ (tree *type, int tcode, const char *name);
 static void ffecom_f2c_set_lio_code_ (ffeinfoBasictype bt, int size,
@@ -470,6 +457,8 @@ 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_prepare_let_char_ (ffetargetCharacterSize dest_size,
+				      ffebld source);
 static void ffecom_push_dummy_decls_ (ffebld dumlist,
 				      bool stmtfunc);
 static void ffecom_start_progunit_ (void);
@@ -484,7 +473,7 @@ 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);
+				 bool *dest_used, tree hook);
 static tree ffecom_type_localvar_ (ffesymbol s,
 				   ffeinfoBasictype bt,
 				   ffeinfoKindtype kt);
@@ -504,11 +493,12 @@ static tree ffecom_convert_widen_ (tree type, tree expr);
    end and thus have the same names.  */
 
 #if FFECOM_targetCURRENT == FFECOM_targetGCC
-static void bison_rule_compstmt_ (void);
+static tree bison_rule_compstmt_ (void);
 static void bison_rule_pushlevel_ (void);
 static tree builtin_function (const char *name, tree type,
 			      enum built_in_function function_code,
 			      const char *library_name);
+static void delete_block (tree block);
 static int duplicate_decls (tree newdecl, tree olddecl);
 static void finish_decl (tree decl, tree init, bool is_top_level);
 static void finish_function (int nested);
@@ -519,6 +509,7 @@ static void pop_f_function_context (void);
 static void push_f_function_context (void);
 static void push_parm_decl (tree parm);
 static tree pushdecl_top_level (tree decl);
+static int kept_level_p (void);
 static tree storedecls (tree decls);
 static void store_parm_decls (int is_main_program);
 static tree start_decl (tree decl, bool is_top_level);
@@ -543,8 +534,6 @@ static bool ffecom_primary_entry_is_proc_;
 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;
@@ -647,9 +636,6 @@ static const char *ffecom_gfrt_argstring_[FFECOM_gfrt]
 #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_
-
 #define ffecom_char_args_(i,l,e) ffecom_char_args_x_((i),(l),(e),FALSE)
 #define ffecom_char_args_with_null_(i,l,e) ffecom_char_args_x_((i),(l),(e),TRUE)
 
@@ -669,20 +655,27 @@ static const char *ffecom_gfrt_argstring_[FFECOM_gfrt]
 
 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. */
+    /* 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.  */
+    /* 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.  */
+    /* 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;
+
+    /* 0: no ffecom_prepare_* functions called at this level yet;
+       1: ffecom_prepare* functions called, except not ffecom_prepare_end;
+       2: ffecom_prepare_end called.  */
+    int prep_state;
   };
 
 #define NULL_BINDING_LEVEL (struct binding_level *) NULL
@@ -705,7 +698,7 @@ static struct binding_level *global_binding_level;
 
 static struct binding_level clear_binding_level
 =
-{NULL, NULL, NULL, NULL_BINDING_LEVEL};
+{NULL, NULL, NULL, NULL_BINDING_LEVEL, 0};
 
 /* Language-dependent contents of an identifier.  */
 
@@ -752,7 +745,6 @@ 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
@@ -1563,7 +1555,7 @@ 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)
+	      bool scalar_args, tree hook)
 {
   tree item;
   tree tempvar;
@@ -1583,10 +1575,15 @@ ffecom_call_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex,
 				       callee_commons,
 				       scalar_args))
 	{
-	  tempvar = ffecom_push_tempvar (ffecom_tree_type
+#ifdef HOHO
+	  tempvar = ffecom_make_tempvar (ffecom_tree_type
 					 [FFEINFO_basictypeCOMPLEX][kt],
 					 FFETARGET_charactersizeNONE,
-					 -1, TRUE);
+					 -1);
+#else
+	  tempvar = hook;
+	  assert (tempvar);
+#endif
 	}
       else
 	{
@@ -1598,7 +1595,7 @@ ffecom_call_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex,
       item
 	= build_tree_list (NULL_TREE,
 			   ffecom_1 (ADDR_EXPR,
-				   build_pointer_type (TREE_TYPE (tempvar)),
+				     build_pointer_type (TREE_TYPE (tempvar)),
 				     tempvar));
       TREE_CHAIN (item) = args;
 
@@ -1627,17 +1624,15 @@ 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 callee_commons, bool scalar_args, tree hook)
 {
   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);
@@ -1660,17 +1655,11 @@ ffecom_call_binop_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex,
 
   return ffecom_call_ (fn, kt, is_f2c_complex, type, left_tree,
 		       dest_tree, dest, dest_used, callee_commons,
-		       scalar_args);
+		       scalar_args, hook);
 }
 #endif
 
-/* ffecom_char_args_x_ -- Return ptr/length args for char subexpression
-
-   tree ptr_arg;
-   tree length_arg;
-   ffebld expr;
-   bool with_null;
-   ffecom_char_args_x_(&ptr_arg,&length_arg,expr,with_null);
+/* Return ptr/length args for char subexpression
 
    Handles CHARACTER-type CONTER, SYMTER, SUBSTR, ARRAYREF, and FUNCREF
    subexpressions by constructing the appropriate trees for the ptr-to-
@@ -1696,15 +1685,17 @@ ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null)
       newlen = ffetarget_length_character1 (val);
       if (with_null)
 	{
+	  /* Begin FFETARGET-NULL-KLUDGE.  */
 	  if (newlen != 0)
-	    ++newlen;	/* begin FFETARGET-NULL-KLUDGE. */
+	    ++newlen;
 	}
       *length = build_int_2 (newlen, 0);
       TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node;
       high = build_int_2 (newlen, 0);
       TREE_TYPE (high) = ffecom_f2c_ftnlen_type_node;
-      item = build_string (newlen,	/* end FFETARGET-NULL-KLUDGE. */
+      item = build_string (newlen,
 			   ffetarget_text_character1 (val));
+      /* End FFETARGET-NULL-KLUDGE.  */
       TREE_TYPE (item)
 	= build_type_variant
 	  (build_array_type
@@ -1742,7 +1733,8 @@ ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null)
 	  }
 	else if (item == error_mark_node)
 	  *length = error_mark_node;
-	else			/* FFEINFO_kindFUNCTION: */
+	else
+	  /* FFEINFO_kindFUNCTION.  */
 	  *length = NULL_TREE;
 	if (!ffesymbol_hook (s).addr
 	    && (item != error_mark_node))
@@ -1758,9 +1750,7 @@ ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null)
 	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)
 	  {
@@ -1805,9 +1795,7 @@ ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null)
 	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)
 	  {
@@ -1892,7 +1880,8 @@ ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null)
 	ffecomGfrt ix;
 
 	if (size == FFETARGET_charactersizeNONE)
-	  size = 24;	/* ~~~~ Kludge alert!  This should someday be fixed. */
+	  /* ~~Kludge alert!  This should someday be fixed. */
+	  size = 24;
 
 	*length = build_int_2 (size, 0);
 	TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node;
@@ -1901,7 +1890,8 @@ ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null)
 	    == FFEINFO_whereINTRINSIC)
 	  {
 	    if (size == 1)
-	      {			/* Invocation of an intrinsic returning CHARACTER*1. */
+	      {
+		/* Invocation of an intrinsic returning CHARACTER*1.  */
 		item = ffecom_expr_intrinsic_ (expr, NULL_TREE,
 					       NULL, NULL);
 		break;
@@ -1929,14 +1919,16 @@ ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null)
 	      item = ffecom_1_fn (item);
 	  }
 
-	assert (ffecom_pending_calls_ != 0);
+#ifdef HOHO
 	tempvar = ffecom_push_tempvar (char_type_node, size, -1, TRUE);
+#else
+	tempvar = ffebld_nonter_hook (expr);
+	assert (tempvar);
+#endif
 	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. */
@@ -1962,16 +1954,12 @@ ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null)
 			  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)
 	{
@@ -1988,9 +1976,13 @@ ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null)
 	  tree args;
 	  tree newlen;
 
-	  assert (ffecom_pending_calls_ != 0);
-	  tempvar = ffecom_push_tempvar (char_type_node,
-					 ffebld_size (expr), -1, TRUE);
+#ifdef HOHO
+	  tempvar = ffecom_make_tempvar (char_type_node,
+					 ffebld_size (expr), -1);
+#else
+	  tempvar = ffebld_nonter_hook (expr);
+	  assert (tempvar);
+#endif
 	  tempvar = ffecom_1 (ADDR_EXPR,
 			      build_pointer_type (TREE_TYPE (tempvar)),
 			      tempvar);
@@ -2004,7 +1996,7 @@ ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null)
 	  TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (args)))
 	    = build_tree_list (NULL_TREE, *length);
 
-	  item = ffecom_call_gfrt (FFECOM_gfrtCOPY, args);
+	  item = ffecom_call_gfrt (FFECOM_gfrtCOPY, args, NULL_TREE);
 	  TREE_SIDE_EFFECTS (item) = 1;
 	  item = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (tempvar), fold (item),
 			   tempvar);
@@ -2082,10 +2074,10 @@ ffecom_char_enhance_arg_ (tree *xtype, ffesymbol s)
     {
       if (ffesymbol_where (s) == FFEINFO_whereDUMMY)
 	tlen = ffecom_get_invented_identifier ("__g77_length_%s",
-					       ffesymbol_text (s), 0);
+					       ffesymbol_text (s), -1);
       else
 	tlen = ffecom_get_invented_identifier ("__g77_%s",
-					       "length", 0);
+					       "length", -1);
       tlen = build_decl (PARM_DECL, tlen, ffecom_f2c_ftnlen_type_node);
 #if BUILT_FOR_270
       DECL_ARTIFICIAL (tlen) = 1;
@@ -2182,7 +2174,8 @@ recurse:			/* :::::::::::::::::::: */
 	    case FFEBLD_opARRAYREF:
 	    case FFEBLD_opFUNCREF:
 	    case FFEBLD_opSUBSTR:
-	      break;		/* ~~Do useful truncations here. */
+	      /* ~~Do useful truncations here. */
+	      break;
 
 	    default:
 	      assert ("op changed or inconsistent switches!" == NULL);
@@ -2243,12 +2236,7 @@ ffecom_concat_list_kill_ (ffecomConcatList_ catlist)
 }
 
 #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);
+/* Make list of concatenated string exprs.
 
    Returns a flattened list of concatenated subexpressions given a
    tree of such expressions.  */
@@ -2526,7 +2514,7 @@ ffecom_do_entry_ (ffesymbol fn, int entrynum)
 	type = ffecom_tree_type[FFEINFO_basictypeCOMPLEX][kt];
 
       result = ffecom_get_invented_identifier ("__g77_%s",
-					       "result", 0);
+					       "result", -1);
 
       /* Make length arg _and_ enhance type info for CHAR arg itself.  */
 
@@ -2556,7 +2544,9 @@ ffecom_do_entry_ (ffesymbol fn, int entrynum)
 
   store_parm_decls (0);
 
-  ffecom_start_compstmt_ ();
+  ffecom_start_compstmt ();
+  /* Disallow temp vars at this level.  */
+  current_binding_level->prep_state = 2;
 
   /* Make local var to hold return type for multi-type master fn. */
 
@@ -2565,7 +2555,7 @@ ffecom_do_entry_ (ffesymbol fn, int entrynum)
       yes = suspend_momentary ();
 
       multi_retval = ffecom_get_invented_identifier ("__g77_%s",
-						     "multi_retval", 0);
+						     "multi_retval", -1);
       multi_retval = build_decl (VAR_DECL, multi_retval,
 				 ffecom_multi_type_node_);
       multi_retval = start_decl (multi_retval, FALSE);
@@ -2726,7 +2716,7 @@ ffecom_do_entry_ (ffesymbol fn, int entrynum)
     clear_momentary ();
   }
 
-  ffecom_end_compstmt_ ();
+  ffecom_end_compstmt ();
 
   finish_function (0);
 
@@ -3040,7 +3030,8 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
       left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp);
       return ffecom_1 (NOP_EXPR, tree_type, left);
 
-    case FFEBLD_opPAREN:	/* ~~~Make sure Fortran rules respected here */
+    case FFEBLD_opPAREN:
+      /* ~~~Make sure Fortran rules respected here */
       left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp);
       return ffecom_1 (NOP_EXPR, tree_type, left);
 
@@ -3096,7 +3087,8 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
 	  right = convert (tree_type, right);
 	}
       return ffecom_tree_divide_ (tree_type, left, right,
-			          dest_tree, dest, dest_used);
+			          dest_tree, dest, dest_used,
+				  ffebld_nonter_hook (expr));
 
     case FFEBLD_opPOWER:
       {
@@ -3111,7 +3103,7 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
 	  case FFEINFO_basictypeINTEGER:
 	    if (1 || optimize)
 	      {
-		item = ffecom_expr_power_integer_ (left, right);
+		item = ffecom_expr_power_integer_ (expr);
 		if (item != NULL_TREE)
 		  return item;
 	      }
@@ -3228,7 +3220,8 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
 				    && ffecom_gfrt_complex_[code]),
 				   tree_type, left, right,
 				   dest_tree, dest, dest_used,
-				   NULL_TREE, FALSE);
+				   NULL_TREE, FALSE,
+				   ffebld_nonter_hook (expr));
       }
 
     case FFEBLD_opNOT:
@@ -3277,12 +3270,10 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
       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 ();
 
       if (args == error_mark_node)
 	return error_mark_node;
@@ -3295,7 +3286,8 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
 			   tree_type,
 			   args,
 			   dest_tree, dest, dest_used,
-			   error_mark_node, FALSE);
+			   error_mark_node, FALSE,
+			   ffebld_nonter_hook (expr));
       TREE_SIDE_EFFECTS (item) = 1;
       return item;
 
@@ -3513,8 +3505,6 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
 	  }
 
 	case FFEINFO_basictypeCHARACTER:
-	  ffecom_push_calltemps ();	/* Even though we might not call. */
-
 	  {
 	    ffebld left = ffebld_left (expr);
 	    ffebld right = ffebld_right (expr);
@@ -3546,10 +3536,7 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
 	    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;
-	      }
+	      return error_mark_node;
 
 	    if ((ffebld_size_known (left) == 1)
 		&& (ffebld_size_known (right) == 1))
@@ -3582,7 +3569,7 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
 							       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_call_gfrt (FFECOM_gfrtCMP, item, NULL_TREE);
 		item = ffecom_2 (code, integer_type_node,
 				 item,
 				 convert (TREE_TYPE (item),
@@ -3591,7 +3578,6 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
 	    item = convert (tree_type, item);
 	  }
 
-	  ffecom_pop_calltemps ();
 	  return item;
 
 	default:
@@ -3793,8 +3779,8 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 
     case FFEINTRIN_impAINT:
     case FFEINTRIN_impDINT:
-#if 0				/* ~~ someday implement FIX_TRUNC_EXPR
-				   yielding same type as arg */
+#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); */
@@ -3810,14 +3796,16 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 			   ffecom_call_gfrt (FFECOM_gfrtL_FLOOR,
 					     build_tree_list (NULL_TREE,
 						  convert (double_type_node,
-							   saved_expr1))),
+							   saved_expr1)),
+					     NULL_TREE),
 			   ffecom_1 (NEGATE_EXPR, double_type_node,
 				     ffecom_call_gfrt (FFECOM_gfrtL_FLOOR,
 						 build_tree_list (NULL_TREE,
 						  convert (double_type_node,
 						      ffecom_1 (NEGATE_EXPR,
 								arg1_type,
-								saved_expr1))))
+							       saved_expr1))),
+						       NULL_TREE)
 				     ))
 		 );
 #endif
@@ -3862,7 +3850,8 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 								     arg1_type,
 								     saved_expr1,
 								     convert (arg1_type,
-									      ffecom_float_half_))))),
+									      ffecom_float_half_)))),
+					     NULL_TREE),
 			   ffecom_1 (NEGATE_EXPR, double_type_node,
 				     ffecom_call_gfrt (FFECOM_gfrtL_FLOOR,
 						       build_tree_list (NULL_TREE,
@@ -3871,7 +3860,8 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 											   arg1_type,
 											   convert (arg1_type,
 												    ffecom_float_half_),
-											   saved_expr1)))))
+											   saved_expr1))),
+						       NULL_TREE))
 			   )
 		 );
 #endif
@@ -3886,9 +3876,12 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 
     case FFEINTRIN_impCHAR:
     case FFEINTRIN_impACHAR:
-      assert (ffecom_pending_calls_ != 0);
-      tempvar = ffecom_push_tempvar (char_type_node,
-				     1, -1, TRUE);
+#ifdef HOHO
+      tempvar = ffecom_make_tempvar (char_type_node, 1, -1);
+#else
+      tempvar = ffebld_nonter_hook (expr);
+      assert (tempvar);
+#endif
       {
 	tree tmv = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (tempvar)));
 
@@ -4138,8 +4131,8 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 
     case FFEINTRIN_impNINT:
     case FFEINTRIN_impIDNINT:
-#if 0				/* ~~ ideally FIX_ROUND_EXPR would be
-				   implemented, but it ain't yet */
+#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); */
@@ -4552,13 +4545,11 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 	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_tree = ffecom_expr_rw (NULL_TREE, arg4);
 	arg4_type = TREE_TYPE (arg4_tree);
 
 	arg1_tree = ffecom_save_tree (convert (arg4_type,
@@ -4567,8 +4558,6 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 	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,
@@ -4686,8 +4675,6 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_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,
@@ -4703,12 +4690,10 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 			     arg2_tree);
 
 	if (arg3 != NULL)
-	  arg3_tree = ffecom_expr_rw (arg3);
+	  arg3_tree = ffecom_expr_w (NULL_TREE, 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;
@@ -4721,7 +4706,8 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 			   NULL_TREE :
 			   tree_type),
 			  arg1_tree,
-			  NULL_TREE, NULL, NULL, NULL_TREE, TRUE);
+			  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
+			  ffebld_nonter_hook (expr));
 
 	if (arg3_tree != NULL_TREE)
 	  expr_tree
@@ -4737,8 +4723,6 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_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,
@@ -4754,12 +4738,10 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 			     arg2_tree);
 
 	if (arg3 != NULL)
-	  arg3_tree = ffecom_expr_rw (arg3);
+	  arg3_tree = ffecom_expr_w (NULL_TREE, 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;
@@ -4770,7 +4752,8 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 			  FALSE,
 			  NULL_TREE,
 			  arg1_tree,
-			  NULL_TREE, NULL, NULL, NULL_TREE, TRUE);
+			  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
+			  ffebld_nonter_hook (expr));
 
 	if (arg3_tree != NULL_TREE)
 	  expr_tree
@@ -4793,17 +4776,13 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 	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);
+	  arg2_tree = ffecom_expr_w (NULL_TREE, 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;
@@ -4814,7 +4793,8 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 			  FALSE,
 			  NULL_TREE,
 			  arg1_tree,
-			  NULL_TREE, NULL, NULL, NULL_TREE, TRUE);
+			  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
+			  ffebld_nonter_hook (expr));
 
 	if (arg2_tree != NULL_TREE)
 	  expr_tree
@@ -4840,7 +4820,8 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 		      FALSE,
 		      void_type_node,
 		      expr_tree,
-		      NULL_TREE, NULL, NULL, NULL_TREE, TRUE);
+		      NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
+		      ffebld_nonter_hook (expr));
 
     case FFEINTRIN_impFLUSH:
       if (arg1 == NULL)
@@ -4860,17 +4841,13 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 	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);
+	  arg3_tree = ffecom_expr_w (NULL_TREE, 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);
@@ -4883,7 +4860,8 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 				  FALSE,
 				  NULL_TREE,
 				  arg1_tree,
-				  NULL_TREE, NULL, NULL, NULL_TREE, TRUE);
+				  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
+				  ffebld_nonter_hook (expr));
 	if (arg3_tree != NULL_TREE)
 	  expr_tree = ffecom_modify (NULL_TREE, arg3_tree,
 				     convert (TREE_TYPE (arg3_tree),
@@ -4899,19 +4877,15 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_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);
+	  arg3_tree = ffecom_expr_w (NULL_TREE, 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);
@@ -4922,7 +4896,8 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 				  FALSE,
 				  NULL_TREE,
 				  arg1_tree,
-				  NULL_TREE, NULL, NULL, NULL_TREE, TRUE);
+				  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
+				  ffebld_nonter_hook (expr));
 	if (arg3_tree != NULL_TREE)
 	  expr_tree = ffecom_modify (NULL_TREE, arg3_tree,
 				     convert (TREE_TYPE (arg3_tree),
@@ -4938,8 +4913,6 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_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,
@@ -4947,9 +4920,7 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 			      arg1_tree);
 
 	arg2_tree = ffecom_arg_ptr_to_expr (arg2, &arg2_len);
-	arg3_tree = ffecom_expr_rw (arg3);
-
-	ffecom_pop_calltemps ();
+	arg3_tree = ffecom_expr_w (NULL_TREE, arg3);
 
 	arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
 	arg2_tree = build_tree_list (NULL_TREE, arg2_tree);
@@ -4962,7 +4933,8 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 				  FALSE,
 				  NULL_TREE,
 				  arg1_tree,
-				  NULL_TREE, NULL, NULL, NULL_TREE, TRUE);
+				  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
+				  ffebld_nonter_hook (expr));
 	expr_tree = ffecom_modify (NULL_TREE, arg3_tree,
 				   convert (TREE_TYPE (arg3_tree),
 					    expr_tree));
@@ -4975,8 +4947,6 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_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,
@@ -4989,9 +4959,7 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 	if (arg3 == NULL)
 	  arg3_tree = NULL_TREE;
 	else
-	  arg3_tree = ffecom_expr_rw (arg3);
-
-	ffecom_pop_calltemps ();
+	  arg3_tree = ffecom_expr_w (NULL_TREE, arg3);
 
 	arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
 	arg2_tree = build_tree_list (NULL_TREE, arg2_tree);
@@ -5001,7 +4969,8 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 				  FALSE,
 				  NULL_TREE,
 				  arg1_tree,
-				  NULL_TREE, NULL, NULL, NULL_TREE, TRUE);
+				  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
+				  ffebld_nonter_hook (expr));
 	if (arg3_tree != NULL_TREE) {
 	  expr_tree = ffecom_modify (NULL_TREE, arg3_tree,
 				     convert (TREE_TYPE (arg3_tree),
@@ -5016,8 +4985,6 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_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,
@@ -5033,9 +5000,7 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 	if (arg3 == NULL)
 	  arg3_tree = NULL_TREE;
 	else
-	  arg3_tree = ffecom_expr_rw (arg3);
-
-	ffecom_pop_calltemps ();
+	  arg3_tree = ffecom_expr_w (NULL_TREE, arg3);
 
 	arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
 	arg2_tree = build_tree_list (NULL_TREE, arg2_tree);
@@ -5045,7 +5010,8 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 				  FALSE,
 				  NULL_TREE,
 				  arg1_tree,
-				  NULL_TREE, NULL, NULL, NULL_TREE, TRUE);
+				  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
+				  ffebld_nonter_hook (expr));
 	if (arg3_tree != NULL_TREE) {
 	  expr_tree = ffecom_modify (NULL_TREE, arg3_tree,
 				     convert (TREE_TYPE (arg3_tree),
@@ -5061,8 +5027,6 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 	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) ?
@@ -5073,8 +5037,6 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 			      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);
@@ -5087,7 +5049,8 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 			  FALSE,
 			  NULL_TREE,
 			  arg1_tree,
-			  NULL_TREE, NULL, NULL, NULL_TREE, TRUE);
+			  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
+			  ffebld_nonter_hook (expr));
       }
       return expr_tree;
 
@@ -5116,7 +5079,8 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 				   ffecom_f2c_real_type_node),
 				  arg1_tree,
 				  dest_tree, dest, dest_used,
-				  NULL_TREE, TRUE);
+				  NULL_TREE, TRUE,
+				  ffebld_nonter_hook (expr));
       }
       return expr_tree;
 
@@ -5126,8 +5090,6 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 	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,
@@ -5137,9 +5099,7 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 	if (arg2 == NULL)
 	  arg2_tree = NULL_TREE;
 	else
-	  arg2_tree = ffecom_expr_rw (arg2);
-
-	ffecom_pop_calltemps ();
+	  arg2_tree = ffecom_expr_w (NULL_TREE, arg2);
 
 	expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
 				  ffecom_gfrt_kindtype (gfrt),
@@ -5147,7 +5107,8 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 				  NULL_TREE,
 				  build_tree_list (NULL_TREE, arg1_tree),
 				  NULL_TREE, NULL, NULL, NULL_TREE,
-				  TRUE);
+				  TRUE,
+				  ffebld_nonter_hook (expr));
 	if (arg2_tree != NULL_TREE) {
 	  expr_tree = ffecom_modify (NULL_TREE, arg2_tree,
 				     convert (TREE_TYPE (arg2_tree),
@@ -5161,11 +5122,7 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
       {
 	tree arg1_tree;
 
-	ffecom_push_calltemps ();
-
-	arg1_tree = ffecom_expr_rw (arg1);
-
-	ffecom_pop_calltemps ();
+	arg1_tree = ffecom_expr_w (NULL_TREE, arg1);
 
 	expr_tree
 	  = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
@@ -5173,7 +5130,8 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 			  FALSE,
 			  NULL_TREE,
 			  NULL_TREE,
-			  NULL_TREE, NULL, NULL, NULL_TREE, TRUE);
+			  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
+			  ffebld_nonter_hook (expr));
 
 	expr_tree
 	  = ffecom_modify (NULL_TREE, arg1_tree,
@@ -5188,28 +5146,25 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 	tree arg1_tree;
 	tree arg2_tree;
 
-	ffecom_push_calltemps ();
-
-	arg1_tree = ffecom_expr_rw (arg1);
+	arg1_tree = ffecom_expr_w (NULL_TREE, 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);
+				  TRUE,
+				  ffebld_nonter_hook (expr));
 	expr_tree = ffecom_modify (NULL_TREE, arg1_tree,
 				   convert (TREE_TYPE (arg1_tree),
 					    expr_tree));
       }
       return expr_tree;
 
-    /* Straightforward calls of libf2c routines: */
+      /* Straightforward calls of libf2c routines: */
     case FFEINTRIN_impABORT:
     case FFEINTRIN_impACCESS:
     case FFEINTRIN_impBESJ0:
@@ -5290,890 +5245,20 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 
   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.
+		       NULL_TREE, TRUE,
+		       ffebld_nonter_hook (expr));
 
--------- (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)
-
-*/
+  /* See bottom of this file for f2c transforms used to determine
+     many of the above implementations.  The info seems to confuse
+     Emacs's C mode indentation, which is why it's been moved to
+     the bottom of this source file.  */
 }
 
 #endif
@@ -6183,10 +5268,10 @@ typedef doublereal E_f; // real function with -R not specified //
 
 #if FFECOM_targetCURRENT == FFECOM_targetGCC
 static tree
-ffecom_expr_power_integer_ (ffebld left, ffebld right)
+ffecom_expr_power_integer_ (ffebld expr)
 {
-  tree l = ffecom_expr (left);
-  tree r = ffecom_expr (right);
+  tree l = ffecom_expr (ffebld_left (expr));
+  tree r = ffecom_expr (ffebld_right (expr));
   tree ltype = TREE_TYPE (l);
   tree rtype = TREE_TYPE (r);
   tree result = NULL_TREE;
@@ -6212,7 +5297,7 @@ ffecom_expr_power_integer_ (ffebld left, ffebld right)
 	  result = ffecom_tree_divide_ (ltype,
 					convert (ltype, integer_one_node),
 					l,
-					NULL_TREE, NULL, NULL);
+					NULL_TREE, NULL, NULL, NULL_TREE);
 	  r = ffecom_1 (NEGATE_EXPR,
 			rtype,
 			r);
@@ -6231,7 +5316,8 @@ ffecom_expr_power_integer_ (ffebld left, ffebld right)
 	  l = ffecom_tree_divide_ (ltype,
 				   convert (ltype, integer_one_node),
 				   l,
-				   NULL_TREE, NULL, NULL);
+				   NULL_TREE, NULL, NULL,
+				   ffebld_nonter_hook (expr));
 	  r = ffecom_1 (NEGATE_EXPR, rtype, r);
 	  assert (TREE_CODE (r) == INTEGER_CST);
 
@@ -6351,21 +5437,50 @@ ffecom_expr_power_integer_ (ffebld left, ffebld right)
   {
     tree rtmp;
     tree ltmp;
+    tree divide;
     tree basetypeof_l_is_int;
     tree se;
+    tree t;
 
     basetypeof_l_is_int
       = build_int_2 ((TREE_CODE (ltype) == INTEGER_TYPE), 0);
 
     se = expand_start_stmt_expr ();
-    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);
+    ffecom_start_compstmt ();
+
+#ifndef HAHA
+    rtmp = ffecom_make_tempvar ("power_r", rtype,
+				FFETARGET_charactersizeNONE, -1);
+    ltmp = ffecom_make_tempvar ("power_l", ltype,
+				FFETARGET_charactersizeNONE, -1);
+    result = ffecom_make_tempvar ("power_res", ltype,
+				  FFETARGET_charactersizeNONE, -1);
+    if (TREE_CODE (ltype) == COMPLEX_TYPE
+	|| TREE_CODE (ltype) == RECORD_TYPE)
+      divide = ffecom_make_tempvar ("power_div", ltype,
+				    FFETARGET_charactersizeNONE, -1);
+    else
+      divide = NULL_TREE;
+#else  /* HAHA */
+    {
+      tree hook;
+
+      hook = ffebld_nonter_hook (expr);
+      assert (hook);
+      assert (TREE_CODE (hook) == TREE_VEC);
+      assert (TREE_VEC_LENGTH (hook) == 4);
+      rtmp = TREE_VEC_ELT (hook, 0);
+      ltmp = TREE_VEC_ELT (hook, 1);
+      result = TREE_VEC_ELT (hook, 2);
+      divide = TREE_VEC_ELT (hook, 3);
+      if (TREE_CODE (ltype) == COMPLEX_TYPE
+	  || TREE_CODE (ltype) == RECORD_TYPE)
+	assert (divide);
+      else
+	assert (! divide);
+    }
+#endif  /* HAHA */
 
     expand_expr_stmt (ffecom_modify (void_type_node,
 				     rtmp,
@@ -6382,7 +5497,7 @@ ffecom_expr_power_integer_ (ffebld left, ffebld right)
 				     result,
 				     convert (ltype, integer_one_node)));
     expand_start_else ();
-    if (!integer_zerop (basetypeof_l_is_int))
+    if (! integer_zerop (basetypeof_l_is_int))
       {
 	expand_start_cond (ffecom_2 (LT_EXPR, integer_type_node,
 				     rtmp,
@@ -6395,7 +5510,8 @@ ffecom_expr_power_integer_ (ffebld left, ffebld right)
 					 (ltype,
 					  convert (ltype, integer_one_node),
 					  ltmp,
-					  NULL_TREE, NULL, NULL)));
+					  NULL_TREE, NULL, NULL,
+					  divide)));
 	expand_start_cond (ffecom_truth_value
 			   (ffecom_2 (TRUTH_ANDIF_EXPR, integer_type_node,
 				      ffecom_2 (LT_EXPR, integer_type_node,
@@ -6439,7 +5555,8 @@ ffecom_expr_power_integer_ (ffebld left, ffebld right)
 				     (ltype,
 				      convert (ltype, integer_one_node),
 				      ltmp,
-				      NULL_TREE, NULL, NULL)));
+				      NULL_TREE, NULL, NULL,
+				      divide)));
     expand_expr_stmt (ffecom_modify (void_type_node,
 				     rtmp,
 				     ffecom_1 (NEGATE_EXPR, rtype,
@@ -6494,9 +5611,24 @@ ffecom_expr_power_integer_ (ffebld left, ffebld right)
       expand_end_cond ();
     expand_expr_stmt (result);
 
-    ffecom_pop_calltemps ();
+    t = ffecom_end_compstmt ();
+
     result = expand_end_stmt_expr (se);
-    TREE_SIDE_EFFECTS (result) = 1;
+
+    /* This code comes from c-parse.in, after its expand_end_stmt_expr.  */
+
+    if (TREE_CODE (t) == BLOCK)
+      {
+	/* Make a BIND_EXPR for the BLOCK already made.  */
+	result = build (BIND_EXPR, TREE_TYPE (result),
+			NULL_TREE, result, t);
+	/* Remove the block from the tree at this point.
+	   It gets put back at the proper place
+	   when the BIND_EXPR is expanded.  */
+	delete_block (t);
+      }
+    else
+      result = t;
   }
 
   return result;
@@ -6634,7 +5766,7 @@ ffecom_f2c_make_type_ (tree *type, int tcode, const char *name)
 
   pushdecl (build_decl (TYPE_DECL,
 			ffecom_get_invented_identifier ("__g77_f2c_%s",
-							name, 0),
+							name, -1),
 			*type));
 }
 
@@ -6904,8 +6036,6 @@ ffecom_gen_sfuncdef_ (ffesymbol s, ffeinfoBasictype bt, ffeinfoKindtype kt)
 
   push_f_function_context ();
 
-  ffecom_push_calltemps ();
-
   if (charfunc)
     type = void_type_node;
   else
@@ -6934,7 +6064,7 @@ ffecom_gen_sfuncdef_ (ffesymbol s, ffeinfoBasictype bt, ffeinfoKindtype kt)
       type = ffecom_tree_type[FFEINFO_basictypeCHARACTER][kt];
 
       result = ffecom_get_invented_identifier ("__g77_%s",
-					       "result", 0);
+					       "result", -1);
 
       ffecom_char_enhance_arg_ (&type, s);	/* Ignore returned length. */
 
@@ -6952,7 +6082,7 @@ ffecom_gen_sfuncdef_ (ffesymbol s, ffeinfoBasictype bt, ffeinfoKindtype kt)
 
   store_parm_decls (0);
 
-  ffecom_start_compstmt_ ();
+  ffecom_start_compstmt ();
 
   if (expr != NULL)
     {
@@ -6964,24 +6094,32 @@ ffecom_gen_sfuncdef_ (ffesymbol s, ffeinfoBasictype bt, ffeinfoKindtype kt)
 	  result_length = build_int_2 (sz, 0);
 	  TREE_TYPE (result_length) = ffecom_f2c_ftnlen_type_node;
 
+	  ffecom_prepare_let_char_ (sz, expr);
+
+	  ffecom_prepare_end ();
+
 	  ffecom_let_char_ (result, result_length, sz, expr);
 	  expand_null_return ();
 	}
       else
-	expand_return (ffecom_modify (NULL_TREE,
-				      DECL_RESULT (current_function_decl),
-				      ffecom_expr (expr)));
+	{
+	  ffecom_prepare_expr (expr);
+
+	  ffecom_prepare_end ();
+
+	  expand_return (ffecom_modify (NULL_TREE,
+					DECL_RESULT (current_function_decl),
+					ffecom_expr (expr)));
+	}
 
       clear_momentary ();
     }
 
-  ffecom_end_compstmt_ ();
+  ffecom_end_compstmt ();
 
   func = current_function_decl;
   finish_function (1);
 
-  ffecom_pop_calltemps ();
-
   pop_f_function_context ();
 
   resume_momentary (yes);
@@ -7105,9 +6243,7 @@ ffecom_intrinsic_ichar_ (tree tree_type, ffebld arg,
     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))
@@ -7333,13 +6469,7 @@ ffecom_intrinsic_len_ (ffebld expr)
 }
 
 #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);
+/* Handle CHARACTER assignments.
 
    Generates code to do the assignment.	 Used by ordinary assignment
    statement handler ffecom_let_stmt and by statement-function
@@ -7386,7 +6516,7 @@ ffecom_let_char_ (tree dest_tree, 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);
+      expr_tree = ffecom_call_gfrt (FFECOM_gfrtCOPY, expr_tree, NULL_TREE);
       TREE_SIDE_EFFECTS (expr_tree) = 1;
 
       expand_expr_stmt (expr_tree);
@@ -7443,7 +6573,7 @@ ffecom_let_char_ (tree dest_tree, 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);
+      expr_tree = ffecom_call_gfrt (FFECOM_gfrtCOPY, expr_tree, NULL_TREE);
       TREE_SIDE_EFFECTS (expr_tree) = 1;
 
       expand_expr_stmt (expr_tree);
@@ -7466,6 +6596,7 @@ ffecom_let_char_ (tree dest_tree, tree dest_length,
     tree citem;
     tree clength;
 
+#ifdef HOHO
     length_array
       = lengths
       = ffecom_push_tempvar (ffecom_f2c_ftnlen_type_node,
@@ -7473,6 +6604,18 @@ ffecom_let_char_ (tree dest_tree, tree dest_length,
     item_array = items = ffecom_push_tempvar (ffecom_f2c_address_type_node,
 					      FFETARGET_charactersizeNONE,
 					      count, TRUE);
+#else
+    {
+      tree hook;
+
+      hook = ffebld_nonter_hook (source);
+      assert (hook);
+      assert (TREE_CODE (hook) == TREE_VEC);
+      assert (TREE_VEC_LENGTH (hook) == 2);
+      length_array = lengths = TREE_VEC_ELT (hook, 0);
+      item_array = items = TREE_VEC_ELT (hook, 1);
+    }
+#endif
 
     for (i = 0; i < count; ++i)
       {
@@ -7525,7 +6668,7 @@ ffecom_let_char_ (tree dest_tree, tree dest_length,
     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);
+    expr_tree = ffecom_call_gfrt (FFECOM_gfrtCAT, expr_tree, NULL_TREE);
     TREE_SIDE_EFFECTS (expr_tree) = 1;
 
     expand_expr_stmt (expr_tree);
@@ -7704,6 +6847,51 @@ ffecom_member_phase2_ (ffestorag mst, ffestorag st)
 
 #endif
 #endif
+/* Prepare source expression for assignment into a destination perhaps known
+   to be of a specific size.  */
+
+static void
+ffecom_prepare_let_char_ (ffetargetCharacterSize dest_size, ffebld source)
+{
+  ffecomConcatList_ catlist;
+  int count;
+  int i;
+  tree ltmp;
+  tree itmp;
+  tree tempvar = NULL_TREE;
+
+  while (ffebld_op (source) == FFEBLD_opCONVERT)
+    source = ffebld_left (source);
+
+  catlist = ffecom_concat_list_new_ (source, dest_size);
+  count = ffecom_concat_list_count_ (catlist);
+
+  if (count >= 2)
+    {
+      ltmp
+	= ffecom_make_tempvar ("let_char_len", ffecom_f2c_ftnlen_type_node,
+			       FFETARGET_charactersizeNONE, count);
+      itmp
+	= ffecom_make_tempvar ("let_char_item", ffecom_f2c_address_type_node,
+			       FFETARGET_charactersizeNONE, count);
+
+      tempvar = make_tree_vec (2);
+      TREE_VEC_ELT (tempvar, 0) = ltmp;
+      TREE_VEC_ELT (tempvar, 1) = itmp;
+    }
+
+  for (i = 0; i < count; ++i)
+    ffecom_prepare_arg_ptr_to_expr (ffecom_concat_list_expr_ (catlist, i));
+
+  ffecom_concat_list_kill_ (catlist);
+
+  if (tempvar)
+    {
+      ffebld_nonter_set_hook (source, tempvar);
+      current_binding_level->prep_state = 1;
+    }
+}
+
 /* ffecom_push_dummy_decls_ -- Transform dummy args, push parm decls in order
 
    Ignores STAR (alternate-return) dummies.  All other get exec-transitioned
@@ -7920,7 +7108,7 @@ ffecom_start_progunit_ ()
     {
       id = ffecom_get_invented_identifier ("__g77_masterfun_%s",
 					   ffesymbol_text (fn),
-					   0);
+					   -1);
     }
 #if FFETARGET_isENFORCED_MAIN
   else if (main_program)
@@ -7956,7 +7144,7 @@ ffecom_start_progunit_ ()
 	= build_decl (PARM_DECL,
 		      ffecom_get_invented_identifier ("__g77_%s",
 						      "which_entrypoint",
-						      0),
+						      -1),
 		      integer_type_node);
       push_parm_decl (ffecom_which_entrypoint_decl_);
     }
@@ -7976,7 +7164,7 @@ ffecom_start_progunit_ ()
 	type = ffecom_multi_type_node_;
 
       result = ffecom_get_invented_identifier ("__g77_%s",
-					       "result", 0);
+					       "result", -1);
 
       /* Make length arg _and_ enhance type info for CHAR arg itself.  */
 
@@ -8015,7 +7203,9 @@ ffecom_start_progunit_ ()
   if (TREE_CODE (current_function_decl) != ERROR_MARK)
     store_parm_decls (main_program ? 1 : 0);
 
-  ffecom_start_compstmt_ ();
+  ffecom_start_compstmt ();
+  /* Disallow temp vars at this level.  */
+  current_binding_level->prep_state = 2;
 
   lineno = old_lineno;
   input_filename = old_input_filename;
@@ -8052,6 +7242,20 @@ ffecom_sym_transform_ (ffesymbol s)
   int old_lineno = lineno;
   char *old_input_filename = input_filename;
 
+  /* Must ensure special ASSIGN variables are declared at top of outermost
+     block, else they'll end up in the innermost block when their first
+     ASSIGN is seen, which leaves them out of scope when they're the
+     subject of a GOTO or I/O statement.
+
+     We make this variable even if -fugly-assign.  Just let it go unused,
+     in case it turns out there are cases where we really want to use this
+     variable anyway (e.g. ASSIGN to INTEGER*2 variable).  */
+
+  if (! ffecom_transform_only_dummies_
+      && ffesymbol_assigned (s)
+      && ! ffesymbol_hook (s).assign_tree)
+    s = ffecom_sym_transform_assign_ (s);
+
   if (ffesymbol_sfdummyparent (s) == NULL)
     {
       input_filename = ffesymbol_where_filename (s);
@@ -8144,7 +7348,8 @@ ffecom_sym_transform_ (ffesymbol s)
       switch (ffeinfo_where (ffesymbol_info (s)))
 	{
 
-	case FFEINFO_whereCONSTANT:	/* ~~debugging info needed? */
+	case FFEINFO_whereCONSTANT:
+	  /* ~~Debugging info needed? */
 	  assert (!ffecom_transform_only_dummies_);
 	  t = error_mark_node;	/* Shouldn't ever see this in expr. */
 	  break;
@@ -8547,13 +7752,13 @@ ffecom_sym_transform_ (ffesymbol s)
 				   ffecom_integer_zero_node);
 #endif
 
-		/* ~~~gcc/stor-layout.c/layout_type should do this,
+		/* ~~~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
+		/* ~~~Similarly, this fixes dumb0.f.  The C front end
 		   does this, which is why dumb0.c would work.  */
 
 		if (high && TREE_CODE (high) != INTEGER_CST)
@@ -9122,7 +8327,7 @@ ffecom_sym_transform_assign_ (ffesymbol s)
   t = build_decl (VAR_DECL,
 		  ffecom_get_invented_identifier ("__g77_ASSIGN_%s",
 						   ffesymbol_text (s),
-						   0),
+						   -1),
 		  TREE_TYPE (null_pointer_node));
 
   switch (ffesymbol_where (s))
@@ -9442,7 +8647,7 @@ ffecom_transform_equiv_ (ffestorag eqst)
 						    ffesymbol_text
 						    (ffestorag_symbol
 						     (eqst)),
-						    0),
+						    -1),
 		    eqtype);
   DECL_EXTERNAL (eqt) = 0;
   if (is_init
@@ -9847,7 +9052,8 @@ ffecom_tree_canonize_ref_ (tree *decl, tree *offset,
 #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)
+		     tree dest_tree, ffebld dest, bool *dest_used,
+		     tree hook)
 {
   if ((left == error_mark_node)
       || (right == error_mark_node))
@@ -9886,7 +9092,7 @@ ffecom_tree_divide_ (tree tree_type, tree left, tree right,
 			     tree_type,
 			     left,
 			     dest_tree, dest, dest_used,
-			     NULL_TREE, TRUE);
+			     NULL_TREE, TRUE, hook);
       }
       break;
 
@@ -9916,7 +9122,7 @@ ffecom_tree_divide_ (tree tree_type, tree left, tree right,
 			     tree_type,
 			     left,
 			     dest_tree, dest, dest_used,
-			     NULL_TREE, TRUE);
+			     NULL_TREE, TRUE, hook);
       }
       break;
 
@@ -9928,16 +9134,7 @@ ffecom_tree_divide_ (tree tree_type, tree left, tree 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.	*/
+/* Build type info for non-dummy variable.  */
 
 #if FFECOM_targetCURRENT == FFECOM_targetGCC
 static tree
@@ -10900,6 +10097,7 @@ ffecom_3s (enum tree_code code, tree type, tree node1,
 }
 
 #endif
+
 /* ffecom_arg_expr -- Transform argument expr into gcc tree
 
    See use by ffecom_list_expr.
@@ -10935,6 +10133,51 @@ ffecom_arg_expr (ffebld expr, tree *length)
 }
 
 #endif
+/* Transform expression into constant argument-pointer-to-expression tree.
+
+   If the expression can be transformed into a argument-pointer-to-expression
+   tree that is constant, that is done, and the tree returned.  Else
+   NULL_TREE is returned.
+
+   That way, a caller can attempt to provide compile-time initialization
+   of a variable and, if that fails, *then* choose to start a new block
+   and resort to using temporaries, as appropriate.  */
+
+tree
+ffecom_arg_ptr_to_const_expr (ffebld expr, tree *length)
+{
+  if (! expr)
+    return integer_zero_node;
+
+  if (ffebld_op (expr) == FFEBLD_opANY)
+    {
+      if (length)
+	*length = error_mark_node;
+      return error_mark_node;
+    }
+
+  if (ffebld_arity (expr) == 0
+      && (ffebld_op (expr) != FFEBLD_opSYMTER
+	  || ffebld_where (expr) == FFEINFO_whereCOMMON
+	  || ffebld_where (expr) == FFEINFO_whereGLOBAL
+	  || ffebld_where (expr) == FFEINFO_whereINTRINSIC))
+    {
+      tree t;
+
+      t = ffecom_arg_ptr_to_expr (expr, length);
+      assert (TREE_CONSTANT (t));
+      assert (! length || TREE_CONSTANT (*length));
+      return t;
+    }
+
+  if (length
+      && ffebld_size (expr) != FFETARGET_charactersizeNONE)
+    *length = build_int_2 (ffebld_size (expr), 0);
+  else if (length)
+    *length = NULL_TREE;
+  return NULL_TREE;
+}
+
 /* ffecom_arg_ptr_to_expr -- Transform argument expr into gcc tree
 
    See use by ffecom_list_ptr_to_expr.
@@ -11083,6 +10326,11 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length)
     tree known_length;
     ffetargetCharacterSize sz;
 
+    sz = ffecom_concat_list_maxlen_ (catlist);
+    /* ~~Kludge! */
+    assert (sz != FFETARGET_charactersizeNONE);
+
+#ifdef HOHO
     length_array
       = lengths
       = ffecom_push_tempvar (ffecom_f2c_ftnlen_type_node,
@@ -11091,6 +10339,21 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length)
       = items
       = ffecom_push_tempvar (ffecom_f2c_address_type_node,
 			     FFETARGET_charactersizeNONE, count, TRUE);
+    temporary = ffecom_push_tempvar (char_type_node,
+				     sz, -1, TRUE);
+#else
+    {
+      tree hook;
+
+      hook = ffebld_nonter_hook (expr);
+      assert (hook);
+      assert (TREE_CODE (hook) == TREE_VEC);
+      assert (TREE_VEC_LENGTH (hook) == 3);
+      length_array = lengths = TREE_VEC_ELT (hook, 0);
+      item_array = items = TREE_VEC_ELT (hook, 1);
+      temporary = TREE_VEC_ELT (hook, 2);
+    }
+#endif
 
     known_length = ffecom_f2c_ftnlen_zero_node;
 
@@ -11137,11 +10400,6 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length)
 		      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);
@@ -11168,7 +10426,7 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length)
     TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (item))))
       = build_tree_list (NULL_TREE, num);
 
-    item = ffecom_call_gfrt (FFECOM_gfrtCAT, item);
+    item = ffecom_call_gfrt (FFECOM_gfrtCAT, item, NULL_TREE);
     TREE_SIDE_EFFECTS (item) = 1;
     item = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (temporary),
 		     item,
@@ -11184,10 +10442,7 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length)
 }
 
 #endif
-/* ffecom_call_gfrt -- Generate call to run-time function
-
-   tree expr;
-   expr = ffecom_call_gfrt(FFECOM_gfrtSTOPNIL,NULL_TREE);
+/* Generate call to run-time function.
 
    The first arg is the GNU Fortran Run-Time function index, the second
    arg is the list of arguments to pass to it.	Returned is the expression
@@ -11196,23 +10451,17 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length)
 
 #if FFECOM_targetCURRENT == FFECOM_targetGCC
 tree
-ffecom_call_gfrt (ffecomGfrt ix, tree args)
+ffecom_call_gfrt (ffecomGfrt ix, tree args, tree hook)
 {
   return ffecom_call_ (ffecom_gfrt_tree_ (ix),
 		       ffecom_gfrt_kindtype (ix),
 		       ffe_is_f2c_library () && ffecom_gfrt_complex_[ix],
 		       NULL_TREE, args, NULL_TREE, NULL,
-		       NULL, NULL_TREE, TRUE);
+		       NULL, NULL_TREE, TRUE, hook);
 }
 #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);  */
+/* Transform constant-union to tree.  */
 
 #if FFECOM_targetCURRENT == FFECOM_targetGCC
 tree
@@ -11484,6 +10733,43 @@ ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt,
 
 #endif
 
+/* Transform expression into constant tree.
+
+   If the expression can be transformed into a tree that is constant,
+   that is done, and the tree returned.  Else NULL_TREE is returned.
+
+   That way, a caller can attempt to provide compile-time initialization
+   of a variable and, if that fails, *then* choose to start a new block
+   and resort to using temporaries, as appropriate.  */
+
+tree
+ffecom_const_expr (ffebld expr)
+{
+  if (! expr)
+    return integer_zero_node;
+
+  if (ffebld_op (expr) == FFEBLD_opANY)
+    return error_mark_node;
+
+  if (ffebld_arity (expr) == 0
+      && (ffebld_op (expr) != FFEBLD_opSYMTER
+#if NEWCOMMON
+	  /* ~~Enable once common/equivalence is handled properly?  */
+	  || ffebld_where (expr) == FFEINFO_whereCOMMON
+#endif
+	  || ffebld_where (expr) == FFEINFO_whereGLOBAL
+	  || ffebld_where (expr) == FFEINFO_whereINTRINSIC))
+    {
+      tree t;
+
+      t = ffecom_expr (expr);
+      assert (TREE_CONSTANT (t));
+      return t;
+    }
+
+  return NULL_TREE;
+}
+
 /* Handy way to make a field in a struct/union.  */
 
 #if FFECOM_targetCURRENT == FFECOM_targetGCC
@@ -11522,6 +10808,16 @@ ffecom_decode_include_option (char *spec)
 #endif
 }
 
+/* End a compound statement (block).  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_end_compstmt (void)
+{
+  return bison_rule_compstmt_ ();
+}
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
 /* ffecom_end_transition -- Perform end transition on all symbols
 
    ffecom_end_transition();
@@ -11643,11 +10939,7 @@ ffecom_exec_transition ()
     ffebad_set_inhibit (TRUE);
 }
 
-/* ffecom_expand_let_stmt -- Compile let (assignment) statement
-
-   ffebld dest;
-   ffebld source;
-   ffecom_expand_let_stmt(dest,source);
+/* Handle assignment statement.
 
    Convert dest and source using ffecom_expr, then join them
    with an ASSIGN op and pass the whole thing to expand_expr_stmt.  */
@@ -11665,7 +10957,28 @@ ffecom_expand_let_stmt (ffebld dest, ffebld source)
     {
       bool dest_used;
 
-      dest_tree = ffecom_expr_rw (dest);
+      /* This attempts to replicate the test below, but must not be
+	 true when the test below is false.  (Always err on the side
+	 of creating unused temporaries, to avoid ICEs.)  */
+      if (ffebld_op (dest) != FFEBLD_opSYMTER
+	  || ((dest_tree = ffesymbol_hook (ffebld_symter (dest)).decl_tree)
+	      && (TREE_CODE (dest_tree) != VAR_DECL
+		  || TREE_ADDRESSABLE (dest_tree))))
+	{
+	  ffecom_prepare_expr_ (source, dest);
+	  dest_used = TRUE;
+	}
+      else
+	{
+	  ffecom_prepare_expr_ (source, NULL);
+	  dest_used = FALSE;
+	}
+
+      ffecom_prepare_expr_w (NULL_TREE, dest);
+
+      ffecom_prepare_end ();
+
+      dest_tree = ffecom_expr_w (NULL_TREE, dest);
       if (dest_tree == error_mark_node)
 	return;
 
@@ -11675,8 +10988,9 @@ ffecom_expand_let_stmt (ffebld dest, ffebld source)
 				    FALSE, FALSE);
       else
 	{
-	  source_tree = ffecom_expr (source);
+	  assert (! dest_used);
 	  dest_used = FALSE;
+	  source_tree = ffecom_expr (source);
 	}
       if (source_tree == error_mark_node)
 	return;
@@ -11692,11 +11006,14 @@ ffecom_expand_let_stmt (ffebld dest, ffebld source)
       return;
     }
 
-  ffecom_push_calltemps ();
+  ffecom_prepare_let_char_ (ffebld_size_known (dest), source);
+  ffecom_prepare_expr_w (NULL_TREE, dest);
+
+  ffecom_prepare_end ();
+
   ffecom_char_args_ (&dest_tree, &dest_length, dest);
   ffecom_let_char_ (dest_tree, dest_length, ffebld_size_known (dest),
 		    source);
-  ffecom_pop_calltemps ();
 }
 
 #endif
@@ -11745,9 +11062,29 @@ ffecom_expr_assign_w (ffebld expr)
 
 #if FFECOM_targetCURRENT == FFECOM_targetGCC
 tree
-ffecom_expr_rw (ffebld expr)
+ffecom_expr_rw (tree type, ffebld expr)
+{
+  assert (expr != NULL);
+  /* Different target types not yet supported.  */
+  assert (type == NULL_TREE || type == ffecom_type_expr (expr));
+
+  return stabilize_reference (ffecom_expr (expr));
+}
+
+#endif
+/* Transform expr for use as into write tree and stabilize the
+   reference.  Not for use on CHARACTER expressions.
+
+   Recursive descent on expr while making corresponding tree nodes and
+   attaching type info and such.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_expr_w (tree type, ffebld expr)
 {
   assert (expr != NULL);
+  /* Different target types not yet supported.  */
+  assert (type == NULL_TREE || type == ffecom_type_expr (expr));
 
   return stabilize_reference (ffecom_expr (expr));
 }
@@ -11783,7 +11120,7 @@ ffecom_finish_decl (tree decl, tree init, bool is_top_level)
 void
 ffecom_finish_progunit ()
 {
-  ffecom_end_compstmt_ ();
+  ffecom_end_compstmt ();
 
   ffecom_previous_function_decl_ = current_function_decl;
   ffecom_which_entrypoint_decl_ = NULL_TREE;
@@ -11792,33 +11129,54 @@ ffecom_finish_progunit ()
 }
 
 #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".  */
+/* Wrapper for get_identifier.  pattern is sprintf-like, assumed to contain
+   one %s if text is not NULL, assumed to contain one %d if number is
+   not -1.  If both are assumed, the %s is assumed to precede the %d.  */
 
 #if FFECOM_targetCURRENT == FFECOM_targetGCC
 tree
-ffecom_get_invented_identifier (const char *pattern, const char *text, int number)
+ffecom_get_invented_identifier (const char *pattern, const 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);
+  lenlen = 0;
+  if (text)
+    lenlen += strlen (text);
+  if (number != -1)
+    lenlen += 20;
+  if (text || number != -1)
+    {
+      lenlen += strlen (pattern);
+      if (lenlen > ARRAY_SIZE (space))
+	nam = malloc_new_ks (malloc_pool_image (), pattern, lenlen);
+      else
+	nam = &space[0];
+    }
   else
-    nam = &space[0];
+    {
+      lenlen = 0;
+      nam = (char *) pattern;
+    }
+
   if (text == NULL)
-    sprintf (&nam[0], pattern, number);
+    {
+      if (number != -1)
+	sprintf (&nam[0], pattern, number);
+    }
   else
-    sprintf (&nam[0], pattern, text);
+    {
+      if (number == -1)
+	sprintf (&nam[0], pattern, text);
+      else
+	sprintf (&nam[0], pattern, text, number);
+    }
+
   decl = get_identifier (nam);
+
   if (lenlen > ARRAY_SIZE (space))
     malloc_kill_ks (malloc_pool_image (), nam, lenlen);
 
@@ -11986,9 +11344,10 @@ ffecom_init_0 ()
   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 */
+  /* Make the binding_level structure for global names.  */
+  pushlevel (0);
   global_binding_level = current_binding_level;
+  current_binding_level->prep_state = 2;
 
   /* Define `int' and `char' first so that dbx will output them first.  */
 
@@ -12461,8 +11820,9 @@ ffecom_init_0 ()
 			    FFETARGET_f2cTYLOGICAL2);
   ffecom_f2c_set_lio_code_ (FFEINFO_basictypeLOGICAL, CHAR_TYPE_SIZE,
 			    FFETARGET_f2cTYLOGICAL1);
+  /* ~~~Not really such a type in libf2c, e.g. I/O support?  */
   ffecom_f2c_set_lio_code_ (FFEINFO_basictypeLOGICAL, LONG_LONG_TYPE_SIZE,
-			    FFETARGET_f2cTYQUAD	/* ~~~ */);
+			    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.  */
@@ -12683,7 +12043,6 @@ ffecom_init_2 ()
 
   ffecom_master_arglist_ = NULL;
   ++ffecom_num_fns_;
-  ffecom_latest_temp_ = NULL;
   ffecom_primary_entry_ = NULL;
   ffecom_is_altreturning_ = FALSE;
   ffecom_func_result_ = NULL_TREE;
@@ -13107,65 +12466,6 @@ ffecom_open_include (char *name, ffewhereLine l, ffewhereColumn c)
 #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;
@@ -13229,7 +12529,7 @@ ffecom_ptr_to_expr (ffebld expr)
 	if (item == error_mark_node)
 	  return item;
 
-	if ((ffeinfo_where (ffebld_info (expr)) == FFEINFO_whereFLEETING)
+	if ((ffebld_where (expr) == FFEINFO_whereFLEETING)
 	    && !mark_addressable (item))
 	  return error_mark_node;	/* Make sure non-const ref is to
 					   non-reg. */
@@ -13281,8 +12581,6 @@ ffecom_ptr_to_expr (ffebld expr)
       return error_mark_node;
 
     default:
-      assert (ffecom_pending_calls_ > 0);
-
       bt = ffeinfo_basictype (ffebld_info (expr));
       kt = ffeinfo_kindtype (ffebld_info (expr));
 
@@ -13322,60 +12620,27 @@ ffecom_ptr_to_expr (ffebld expr)
 }
 
 #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.  */
+   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.  */
 
 #if FFECOM_targetCURRENT == FFECOM_targetGCC
 tree
-ffecom_push_tempvar (tree type, ffetargetCharacterSize size, int elements,
-		     bool auto_pop)
+ffecom_make_tempvar (const char *commentary, tree type,
+		     ffetargetCharacterSize size, int elements)
 {
-  ffecomTemp_ temp;
   int yes;
   tree t;
   static int mynumber;
 
-  assert (!auto_pop || (ffecom_pending_calls_ > 0));
+  assert (current_binding_level->prep_state < 2);
 
   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)
@@ -13390,42 +12655,369 @@ ffecom_push_tempvar (tree type, ffetargetCharacterSize size, int elements,
 					       build_int_2 (elements - 1,
 							    0)));
   t = build_decl (VAR_DECL,
-		  ffecom_get_invented_identifier ("__g77_expr_%d", NULL,
+		  ffecom_get_invented_identifier ("__g77_%s_%d",
+						  commentary,
 						  mynumber++),
 		  type);
 
-  /* This temp must be put in the same scope as the containing BLOCK
-     (aka function), but for reasons that should be explained elsewhere,
-     the GBE normally decides it should be in a "phantom BLOCK" associated
-     with the expand_start_stmt_expr() call.  So push the topmost
-     sequence back onto the GBE's internal stack before telling it
-     about the decl, then restore it afterwards.  */
-  push_topmost_sequence ();
-
   t = start_decl (t, FALSE);
   finish_decl (t, NULL_TREE, FALSE);
 
-  pop_topmost_sequence ();
-
   resume_momentary (yes);
 
-  temp = malloc_new_kp (ffe_pool_program_unit (), "ffecomTemp_",
-			sizeof (*temp));
+  return t;
+}
+#endif
 
-  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;
+/* Prepare argument pointer to expression.
 
-  ffecom_latest_temp_ = temp;
+   Like ffecom_prepare_expr, except for expressions to be evaluated
+   via ffecom_arg_ptr_to_expr.  */
 
-  return t;
+void
+ffecom_prepare_arg_ptr_to_expr (ffebld expr)
+{
+  /* ~~For now, it seems to be the same thing.  */
+  ffecom_prepare_expr (expr);
+  return;
+}
+
+/* End of preparations.  */
+
+bool
+ffecom_prepare_end (void)
+{
+  int prep_state = current_binding_level->prep_state;
+
+  assert (prep_state < 2);
+  current_binding_level->prep_state = 2;
+
+  return (prep_state == 1) ? TRUE : FALSE;
+}
+
+/* Prepare expression.
+
+   This is called before any code is generated for the current block.
+   It scans the expression, declares any temporaries that might be needed
+   during evaluation of the expression, and stores those temporaries in
+   the appropriate "hook" fields of the expression.  `dest', if not NULL,
+   specifies the destination that ffecom_expr_ will see, in case that
+   helps avoid generating unused temporaries.
+
+   ~~Improve to avoid allocating unused temporaries by taking `dest'
+   into account vis-a-vis aliasing requirements of complex/character
+   functions.  */
+
+void
+ffecom_prepare_expr_ (ffebld expr, ffebld dest UNUSED)
+{
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+  ffetargetCharacterSize sz;
+  tree tempvar = NULL_TREE;
+
+  assert (current_binding_level->prep_state < 2);
+
+  if (! expr)
+    return;
+
+  bt = ffeinfo_basictype (ffebld_info (expr));
+  kt = ffeinfo_kindtype (ffebld_info (expr));
+  sz = ffeinfo_size (ffebld_info (expr));
+
+  /* Generate whatever temporaries are needed to represent the result
+     of the expression.  */
+
+  switch (ffebld_op (expr))
+    {
+    default:
+      /* Don't make temps for SYMTER, CONTER, etc.  */
+      if (ffebld_arity (expr) == 0)
+	break;
+
+      switch (bt)
+	{
+	case FFEINFO_basictypeCOMPLEX:
+	  if (ffebld_op (expr) == FFEBLD_opFUNCREF)
+	    {
+	      ffesymbol s;
+
+	      if (ffebld_op (ffebld_left (expr)) != FFEBLD_opSYMTER)
+		break;
+
+	      s = ffebld_symter (ffebld_left (expr));
+	      if (ffesymbol_where (s) == FFEINFO_whereCONSTANT
+		  || ! ffesymbol_is_f2c (s))
+		break;
+	    }
+	  else if (ffebld_op (expr) == FFEBLD_opPOWER)
+	    {
+	      /* Requires special treatment.  There's no POW_CC function
+		 in libg2c, so POW_ZZ is used, which means we always
+		 need a double-complex temp, not a single-complex.  */
+	      kt = FFEINFO_kindtypeREAL2;
+	    }
+	  else if (ffebld_op (expr) != FFEBLD_opDIVIDE)
+	    /* The other ops don't need temps for complex operands.  */
+	    break;
+
+	  /* ~~~Avoid making temps for some intrinsics, such as AIMAG(C),
+	     REAL(C).  See 19990325-0.f, routine `check', for cases.  */
+	  tempvar = ffecom_make_tempvar ("complex",
+					 ffecom_tree_type
+					 [FFEINFO_basictypeCOMPLEX][kt],
+					 FFETARGET_charactersizeNONE,
+					 -1);
+	  break;
+
+	case FFEINFO_basictypeCHARACTER:
+	  if (ffebld_op (expr) != FFEBLD_opFUNCREF)
+	    break;
+
+	  if (sz == FFETARGET_charactersizeNONE)
+	    /* ~~Kludge alert!  This should someday be fixed. */
+	    sz = 24;
+
+	  tempvar = ffecom_make_tempvar ("char", char_type_node, sz, -1);
+	  break;
+
+	default:
+	  break;
+	}
+      break;
+
+#ifdef HAHA
+    case FFEBLD_opPOWER:
+      {
+	tree rtype, ltype;
+	tree rtmp, ltmp, result;
+
+	ltype = ffecom_type_expr (ffebld_left (expr));
+	rtype = ffecom_type_expr (ffebld_right (expr));
+
+	rtmp = ffecom_make_tempvar (rtype, FFETARGET_charactersizeNONE, -1);
+	ltmp = ffecom_make_tempvar (ltype, FFETARGET_charactersizeNONE, -1);
+	result = ffecom_make_tempvar (ltype, FFETARGET_charactersizeNONE, -1);
+
+	tempvar = make_tree_vec (3);
+	TREE_VEC_ELT (tempvar, 0) = rtmp;
+	TREE_VEC_ELT (tempvar, 1) = ltmp;
+	TREE_VEC_ELT (tempvar, 2) = result;
+      }
+      break;
+#endif  /* HAHA */
+
+    case FFEBLD_opCONCATENATE:
+      {
+	/* This gets special handling, because only one set of temps
+	   is needed for a tree of these -- the tree is treated as
+	   a flattened list of concatenations when generating code.  */
+
+	ffecomConcatList_ catlist;
+	tree ltmp, itmp, result;
+	int count;
+	int i;
+
+	catlist = ffecom_concat_list_new_ (expr, FFETARGET_charactersizeNONE);
+	count = ffecom_concat_list_count_ (catlist);
+
+	if (count >= 2)
+	  {
+	    ltmp
+	      = ffecom_make_tempvar ("concat_len",
+				     ffecom_f2c_ftnlen_type_node,
+				     FFETARGET_charactersizeNONE, count);
+	    itmp
+	      = ffecom_make_tempvar ("concat_item",
+				     ffecom_f2c_address_type_node,
+				     FFETARGET_charactersizeNONE, count);
+	    result
+	      = ffecom_make_tempvar ("concat_res",
+				     char_type_node,
+				     ffecom_concat_list_maxlen_ (catlist),
+				     -1);
+
+	    tempvar = make_tree_vec (3);
+	    TREE_VEC_ELT (tempvar, 0) = ltmp;
+	    TREE_VEC_ELT (tempvar, 1) = itmp;
+	    TREE_VEC_ELT (tempvar, 2) = result;
+	  }
+
+	for (i = 0; i < count; ++i)
+	  ffecom_prepare_arg_ptr_to_expr (ffecom_concat_list_expr_ (catlist,
+								    i));
+
+	ffecom_concat_list_kill_ (catlist);
+
+	if (tempvar)
+	  {
+	    ffebld_nonter_set_hook (expr, tempvar);
+	    current_binding_level->prep_state = 1;
+	  }
+      }
+      return;
+
+    case FFEBLD_opCONVERT:
+      if (bt == FFEINFO_basictypeCHARACTER
+	  && ((ffebld_size_known (ffebld_left (expr))
+	       == FFETARGET_charactersizeNONE)
+	      || (ffebld_size_known (ffebld_left (expr)) >= sz)))
+	tempvar = ffecom_make_tempvar ("convert", char_type_node, sz, -1);
+      break;
+    }
+
+  if (tempvar)
+    {
+      ffebld_nonter_set_hook (expr, tempvar);
+      current_binding_level->prep_state = 1;
+    }
+
+  /* Prepare subexpressions for this expr.  */
+
+  switch (ffebld_op (expr))
+    {
+    case FFEBLD_opPERCENT_LOC:
+      ffecom_prepare_ptr_to_expr (ffebld_left (expr));
+      break;
+
+    case FFEBLD_opPERCENT_VAL:
+    case FFEBLD_opPERCENT_REF:
+      ffecom_prepare_expr (ffebld_left (expr));
+      break;
+
+    case FFEBLD_opPERCENT_DESCR:
+      ffecom_prepare_arg_ptr_to_expr (ffebld_left (expr));
+      break;
+
+    case FFEBLD_opITEM:
+      {
+	ffebld item;
+
+	for (item = expr;
+	     item != NULL;
+	     item = ffebld_trail (item))
+	  if (ffebld_head (item) != NULL)
+	    ffecom_prepare_expr (ffebld_head (item));
+      }
+      break;
+
+    default:
+      /* Need to handle character conversion specially.  */
+      switch (ffebld_arity (expr))
+	{
+	case 2:
+	  ffecom_prepare_expr (ffebld_left (expr));
+	  ffecom_prepare_expr (ffebld_right (expr));
+	  break;
+
+	case 1:
+	  ffecom_prepare_expr (ffebld_left (expr));
+	  break;
+
+	default:
+	  break;
+	}
+    }
+
+  return;
+}
+
+/* Prepare expression for reading and writing.
+
+   Like ffecom_prepare_expr, except for expressions to be evaluated
+   via ffecom_expr_rw.  */
+
+void
+ffecom_prepare_expr_rw (tree type, ffebld expr)
+{
+  /* This is all we support for now.  */
+  assert (type == NULL_TREE || type == ffecom_type_expr (expr));
+
+  /* ~~For now, it seems to be the same thing.  */
+  ffecom_prepare_expr (expr);
+  return;
+}
+
+/* Prepare expression for writing.
+
+   Like ffecom_prepare_expr, except for expressions to be evaluated
+   via ffecom_expr_w.  */
+
+void
+ffecom_prepare_expr_w (tree type, ffebld expr)
+{
+  /* This is all we support for now.  */
+  assert (type == NULL_TREE || type == ffecom_type_expr (expr));
+
+  /* ~~For now, it seems to be the same thing.  */
+  ffecom_prepare_expr (expr);
+  return;
+}
+
+/* Prepare expression for returning.
+
+   Like ffecom_prepare_expr, except for expressions to be evaluated
+   via ffecom_return_expr.  */
+
+void
+ffecom_prepare_return_expr (ffebld expr)
+{
+  assert (current_binding_level->prep_state < 2);
+
+  if (ffecom_primary_entry_kind_ == FFEINFO_kindSUBROUTINE
+      && ffecom_is_altreturning_
+      && expr != NULL)
+    ffecom_prepare_expr (expr);
+}
+
+/* Prepare pointer to expression.
+
+   Like ffecom_prepare_expr, except for expressions to be evaluated
+   via ffecom_ptr_to_expr.  */
+
+void
+ffecom_prepare_ptr_to_expr (ffebld expr)
+{
+  /* ~~For now, it seems to be the same thing.  */
+  ffecom_prepare_expr (expr);
+  return;
+}
+
+/* Transform expression into constant pointer-to-expression tree.
+
+   If the expression can be transformed into a pointer-to-expression tree
+   that is constant, that is done, and the tree returned.  Else NULL_TREE
+   is returned.
+
+   That way, a caller can attempt to provide compile-time initialization
+   of a variable and, if that fails, *then* choose to start a new block
+   and resort to using temporaries, as appropriate.  */
+
+tree
+ffecom_ptr_to_const_expr (ffebld expr)
+{
+  if (! expr)
+    return integer_zero_node;
+
+  if (ffebld_op (expr) == FFEBLD_opANY)
+    return error_mark_node;
+
+  if (ffebld_arity (expr) == 0
+      && (ffebld_op (expr) != FFEBLD_opSYMTER
+	  || ffebld_where (expr) == FFEINFO_whereCOMMON
+	  || ffebld_where (expr) == FFEINFO_whereGLOBAL
+	  || ffebld_where (expr) == FFEINFO_whereINTRINSIC))
+    {
+      tree t;
+
+      t = ffecom_ptr_to_expr (expr);
+      assert (TREE_CONSTANT (t));
+      return t;
+    }
+
+  return NULL_TREE;
 }
 
-#endif
 /* ffecom_return_expr -- Returns return-value expr given alt return expr
 
    tree rtn;  // NULL_TREE means use expand_null_return()
@@ -13521,6 +13113,16 @@ ffecom_save_tree (tree t)
 }
 #endif
 
+/* Start a compound statement (block).  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+void
+ffecom_start_compstmt (void)
+{
+  bison_rule_pushlevel_ ();
+}
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
 /* Public entry point for front end to access start_decl.  */
 
 #if FFECOM_targetCURRENT == FFECOM_targetGCC
@@ -13765,6 +13367,74 @@ ffecom_truth_value_invert (tree expr)
 }
 
 #endif
+
+/* Return the tree that is the type of the expression, as would be
+   returned in TREE_TYPE(ffecom_expr(expr)), without otherwise
+   transforming the expression, generating temporaries, etc.  */
+
+tree
+ffecom_type_expr (ffebld expr)
+{
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+  tree tree_type;
+
+  assert (expr != NULL);
+
+  bt = ffeinfo_basictype (ffebld_info (expr));
+  kt = ffeinfo_kindtype (ffebld_info (expr));
+  tree_type = ffecom_tree_type[bt][kt];
+
+  switch (ffebld_op (expr))
+    {
+    case FFEBLD_opCONTER:
+    case FFEBLD_opSYMTER:
+    case FFEBLD_opARRAYREF:
+    case FFEBLD_opUPLUS:
+    case FFEBLD_opPAREN:
+    case FFEBLD_opUMINUS:
+    case FFEBLD_opADD:
+    case FFEBLD_opSUBTRACT:
+    case FFEBLD_opMULTIPLY:
+    case FFEBLD_opDIVIDE:
+    case FFEBLD_opPOWER:
+    case FFEBLD_opNOT:
+    case FFEBLD_opFUNCREF:
+    case FFEBLD_opSUBRREF:
+    case FFEBLD_opAND:
+    case FFEBLD_opOR:
+    case FFEBLD_opXOR:
+    case FFEBLD_opNEQV:
+    case FFEBLD_opEQV:
+    case FFEBLD_opCONVERT:
+    case FFEBLD_opLT:
+    case FFEBLD_opLE:
+    case FFEBLD_opEQ:
+    case FFEBLD_opNE:
+    case FFEBLD_opGT:
+    case FFEBLD_opGE:
+    case FFEBLD_opPERCENT_LOC:
+      return tree_type;
+
+    case FFEBLD_opACCTER:
+    case FFEBLD_opARRTER:
+    case FFEBLD_opITEM:
+    case FFEBLD_opSTAR:
+    case FFEBLD_opBOUNDS:
+    case FFEBLD_opREPEAT:
+    case FFEBLD_opLABTER:
+    case FFEBLD_opLABTOK:
+    case FFEBLD_opIMPDO:
+    case FFEBLD_opCONCATENATE:
+    case FFEBLD_opSUBSTR:
+    default:
+      assert ("bad op for ffecom_type_expr" == NULL);
+      /* Fall through. */
+    case FFEBLD_opANY:
+      return error_mark_node;
+    }
+}
+
 /* Return PARM_DECL for arg#1 of master fn containing alternate ENTRY points
 
    If the PARM_DECL already exists, return it, else create it.	It's an
@@ -13802,15 +13472,6 @@ ffecom_which_entrypoint_decl ()
 #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);
@@ -13820,6 +13481,24 @@ bison_rule_pushlevel_ ()
   expand_start_bindings (0);
 }
 
+static tree
+bison_rule_compstmt_ ()
+{
+  tree t;
+  int keep = kept_level_p ();
+
+  /* Make the temps go away.  */
+  if (! keep)
+    current_binding_level->names = NULL_TREE;
+
+  emit_line_note (input_filename, lineno);
+  expand_end_bindings (getdecls (), keep, 0);
+  t = poplevel (keep, 1, 0);
+  pop_momentary ();
+
+  return t;
+}
+
 /* Return a definition for a builtin function named NAME and whose data type
    is TYPE.  TYPE should be a function type with argument types.
    FUNCTION_CODE tells later passes how to compile calls to this function.
@@ -14802,6 +14481,7 @@ start_function (tree name, tree type, int nested, int public)
     ffecom_outer_function_decl_ = current_function_decl;
 
   pushlevel (0);
+  current_binding_level->prep_state = 2;
 
   if (TREE_CODE (current_function_decl) != ERROR_MARK)
     {
@@ -14894,9 +14574,9 @@ 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.  */
+/* Print an error message for invalid use of an incomplete type.
+   VALUE is the expression that was used (or 0 if that isn't known)
+   and TYPE is the type that was invalid.  */
 
 void
 incomplete_type_error (value, type)
@@ -14955,6 +14635,30 @@ finish_parse ()
   fclose (finput);
 }
 
+/* Delete the node BLOCK from the current binding level.
+   This is used for the block inside a stmt expr ({...})
+   so that the block can be reinserted where appropriate.  */
+
+static void
+delete_block (block)
+     tree block;
+{
+  tree t;
+  if (current_binding_level->blocks == block)
+    current_binding_level->blocks = TREE_CHAIN (block);
+  for (t = current_binding_level->blocks; t;)
+    {
+      if (TREE_CHAIN (t) == block)
+	TREE_CHAIN (t) = TREE_CHAIN (block);
+      else
+	t = TREE_CHAIN (t);
+    }
+  TREE_CHAIN (block) = NULL;
+  /* Clear TREE_USED which is always set by poplevel.
+     The flag is set again if insert_block is called.  */
+  TREE_USED (block) = 0;
+}
+
 void
 insert_block (block)
      tree block;
@@ -15107,17 +14811,17 @@ poplevel (keep, reverse, functionbody)
      int functionbody;
 {
   register tree link;
-  /* The chain of decls was accumulated in reverse order. Put it into forward
-     order, just for cleanliness.  */
+  /* 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.  */
+  /* 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
@@ -15125,21 +14829,25 @@ poplevel (keep, reverse, functionbody)
   else
     decls = current_binding_level->names;
 
-  /* Output any nested inline functions within this block if they weren't
-     already output.  */
+  /* 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)
+	&& ! 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)
+	/* If this decl was copied from a file-scope decl
+	   on account of a block-scope extern decl,
+	   propagate TREE_ADDRESSABLE to the file-scope decl.
+
+	   DECL_ABSTRACT_ORIGIN can be set to itself if warn_return_type is
+	   true, since then the decl goes through save_for_inline_copying.  */
+	if (DECL_ABSTRACT_ORIGIN (decl) != 0
+	    && DECL_ABSTRACT_ORIGIN (decl) != decl)
 	  TREE_ADDRESSABLE (DECL_ABSTRACT_ORIGIN (decl)) = 1;
-	else
+	else if (DECL_SAVED_INSNS (decl) != 0)
 	  {
 	    push_function_context ();
 	    output_inline_function (decl);
@@ -15147,9 +14855,9 @@ poplevel (keep, reverse, functionbody)
 	  }
       }
 
-  /* 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.  */
+  /* 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);
@@ -15188,15 +14896,16 @@ poplevel (keep, reverse, functionbody)
 	}
     }
 
-  /* 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 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.  */
+      /* 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;
     }
@@ -15221,28 +14930,15 @@ poplevel (keep, reverse, functionbody)
 	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.  */
+  /* 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;
@@ -15398,6 +15094,27 @@ pushdecl (x)
   return x;
 }
 
+/* Nonzero if the current level needs to have a BLOCK made.  */
+
+static int
+kept_level_p ()
+{
+  tree decl;
+
+  for (decl = current_binding_level->names;
+       decl;
+       decl = TREE_CHAIN (decl))
+    {
+      if (TREE_USED (decl) || TREE_CODE (decl) != VAR_DECL
+	  || (DECL_NAME (decl) && ! DECL_ARTIFICIAL (decl)))
+	/* Currently, there aren't supposed to be non-artificial names
+	   at other than the top block for a function -- they're
+	   believed to always be temps.  But it's wise to check anyway.  */
+	return 1;
+    }
+  return 0;
+}
+
 /* Enter a new binding level.
    If TAG_TRANSPARENT is nonzero, do so only for the name space of variables,
    not for that of tags.  */
@@ -15408,7 +15125,12 @@ pushlevel (tag_transparent)
 {
   register struct binding_level *newlevel = NULL_BINDING_LEVEL;
 
-  assert (!tag_transparent);
+  assert (! tag_transparent);
+
+  if (current_binding_level == global_binding_level)
+    {
+      named_labels = 0;
+    }
 
   /* Reuse or create a struct for this binding level.  */
 
@@ -15422,8 +15144,8 @@ pushlevel (tag_transparent)
       newlevel = make_binding_level ();
     }
 
-  /* Add this level to the front of the chain (stack) of levels that are
-     active.  */
+  /* 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;
@@ -15440,7 +15162,7 @@ set_block (block)
   current_binding_level->this_block = block;
 }
 
-/* ~~tree.h SHOULD declare this, because toplev.c references it.  */
+/* ~~gcc/tree.h *should* declare this, because toplev.c references it.  */
 
 /* Can't 'yydebug' a front end not generated by yacc/bison!  */
 
@@ -16523,3 +16245,877 @@ ffecom_open_include_ (char *name, ffewhereLine l, ffewhereColumn c)
   return f;
 }
 #endif	/* FFECOM_GCC_INCLUDE */
+
+/**INDENT* (Do not reformat this comment even with -fca option.)
+   Data-gathering files: Given the source file listed below, compiled with
+   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)
+
+*/
diff --git a/gcc/f/com.h b/gcc/f/com.h
index a438d0b..baa2953 100644
--- a/gcc/f/com.h
+++ b/gcc/f/com.h
@@ -56,6 +56,7 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 
 #if FFECOM_targetCURRENT == FFECOM_targetGCC
 #define FFECOM_constantNULL NULL_TREE
+#define FFECOM_nonterNULL NULL_TREE
 #define FFECOM_globalNULL NULL_TREE
 #define FFECOM_labelNULL NULL_TREE
 #define FFECOM_storageNULL NULL_TREE
@@ -202,6 +203,8 @@ typedef enum
 
 typedef tree ffecomConstant;
 #define FFECOM_constantHOOK
+typedef tree ffecomNonter;
+#define FFECOM_nonterHOOK
 typedef tree ffecomLabel;
 #define FFECOM_globalHOOK
 typedef tree ffecomGlobal;
@@ -279,15 +282,20 @@ tree ffecom_3 (enum tree_code code, tree type, tree node1, tree node2,
 tree ffecom_3s (enum tree_code code, tree type, tree node1, tree node2,
 		tree node3);
 tree ffecom_arg_expr (ffebld expr, tree *length);
+tree ffecom_arg_ptr_to_const_expr (ffebld expr, tree *length);
 tree ffecom_arg_ptr_to_expr (ffebld expr, tree *length);
-tree ffecom_call_gfrt (ffecomGfrt ix, tree args);
+tree ffecom_call_gfrt (ffecomGfrt ix, tree args, tree hook);
 tree ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt,
 			   ffeinfoKindtype kt, tree tree_type);
+tree ffecom_const_expr (ffebld expr);
 tree ffecom_decl_field (tree context, tree prevfield, const char *name,
 			tree type);
 #endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
 void ffecom_close_include (FILE *f);
 int ffecom_decode_include_option (char *spec);
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree ffecom_end_compstmt (void);
+#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
 void ffecom_end_transition (void);
 void ffecom_exec_transition (void);
 void ffecom_expand_let_stmt (ffebld dest, ffebld source);
@@ -295,7 +303,8 @@ void ffecom_expand_let_stmt (ffebld dest, ffebld source);
 tree ffecom_expr (ffebld expr);
 tree ffecom_expr_assign (ffebld expr);
 tree ffecom_expr_assign_w (ffebld expr);
-tree ffecom_expr_rw (ffebld expr);
+tree ffecom_expr_rw (tree type, ffebld expr);
+tree ffecom_expr_w (tree type, ffebld expr);
 void ffecom_finish_compile (void);
 void ffecom_finish_decl (tree decl, tree init, bool is_top_level);
 void ffecom_finish_progunit (void);
@@ -308,6 +317,8 @@ void ffecom_init_2 (void);
 tree ffecom_list_expr (ffebld list);
 tree ffecom_list_ptr_to_expr (ffebld list);
 tree ffecom_lookup_label (ffelab label);
+tree ffecom_make_tempvar (const char *commentary, tree type,
+			  ffetargetCharacterSize size, int elements);
 tree ffecom_modify (tree newtype, tree lhs, tree rhs);
 #endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
 void ffecom_file (char *name);
@@ -316,14 +327,18 @@ 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);
+void ffecom_prepare_arg_ptr_to_expr (ffebld expr);
+bool ffecom_prepare_end (void);
+void ffecom_prepare_expr_ (ffebld expr, ffebld dest);
+void ffecom_prepare_expr_rw (tree type, ffebld expr);
+void ffecom_prepare_expr_w (tree type, ffebld expr);
+void ffecom_prepare_ptr_to_expr (ffebld expr);
+void ffecom_prepare_return_expr (ffebld expr);
+tree ffecom_ptr_to_const_expr (ffebld expr);
 tree ffecom_ptr_to_expr (ffebld expr);
-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);
+void ffecom_start_compstmt (void);
 tree ffecom_start_decl (tree decl, bool is_init);
 void ffecom_sym_commit (ffesymbol s);
 #endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
@@ -335,6 +350,7 @@ void ffecom_sym_retract (ffesymbol s);
 tree ffecom_temp_label (void);
 tree ffecom_truth_value (tree expr);
 tree ffecom_truth_value_invert (tree expr);
+tree ffecom_type_expr (ffebld expr);
 tree ffecom_which_entrypoint_decl (void);
 
 /* These need to be in the front end with exactly these interfaces,
@@ -360,6 +376,7 @@ int mark_addressable (tree expr);
 #define ffecom_f2c_typecode(bt,kt) ffecom_f2c_typecode_[(bt)][(kt)]
 #define ffecom_label_kind() ffecom_label_kind_
 #define ffecom_pointer_kind() ffecom_pointer_kind_
+#define ffecom_prepare_expr(e) ffecom_prepare_expr_ ((e), NULL)
 #endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
 
 #define ffecom_init_1()
diff --git a/gcc/f/stc.c b/gcc/f/stc.c
index 1a74301..b89b747 100644
--- a/gcc/f/stc.c
+++ b/gcc/f/stc.c
@@ -10000,6 +10000,10 @@ ffestc_R838 (ffelexToken label_token, ffebld target,
     return;
   ffestc_labeldef_branch_begin_ ();
 
+  /* Mark target symbol as target of an ASSIGN.  */
+  if (ffebld_op (target) == FFEBLD_opSYMTER)
+    ffesymbol_set_assigned (ffebld_symter (target), TRUE);
+
   if (ffestc_labelref_is_assignable_ (label_token, &label))
     ffestd_R838 (label, target);
 
diff --git a/gcc/f/std.c b/gcc/f/std.c
index 965c465..72037c1 100644
--- a/gcc/f/std.c
+++ b/gcc/f/std.c
@@ -192,17 +192,29 @@ struct _ffestd_stmt_
 	struct
 	  {
 	    mallocPool pool;
+	    ffestw block;
 	    ffebld expr;
 	  }
 	R803;
 	struct
 	  {
 	    mallocPool pool;
+	    ffestw block;
 	    ffebld expr;
 	  }
 	R804;
 	struct
 	  {
+	    ffestw block;
+	  }
+	R805;
+	struct
+	  {
+	    ffestw block;
+	  }
+	R806;
+	struct
+	  {
 	    mallocPool pool;
 	    ffebld expr;
 	  }
@@ -750,27 +762,28 @@ ffestd_stmt_pass_ ()
 	case FFESTD_stmtidR803_:
 	  ffestd_subr_line_restore_ (stmt);
 	  if (okay)
-	    ffeste_R803 (stmt->u.R803.expr);
+	    ffeste_R803 (stmt->u.R803.block, stmt->u.R803.expr);
 	  malloc_pool_kill (stmt->u.R803.pool);
 	  break;
 
 	case FFESTD_stmtidR804_:
 	  ffestd_subr_line_restore_ (stmt);
 	  if (okay)
-	    ffeste_R804 (stmt->u.R804.expr);
+	    ffeste_R804 (stmt->u.R803.block, stmt->u.R804.expr);
 	  malloc_pool_kill (stmt->u.R804.pool);
 	  break;
 
 	case FFESTD_stmtidR805_:
 	  ffestd_subr_line_restore_ (stmt);
 	  if (okay)
-	    ffeste_R805 ();
+	    ffeste_R805 (stmt->u.R803.block);
 	  break;
 
 	case FFESTD_stmtidR806_:
 	  ffestd_subr_line_restore_ (stmt);
 	  if (okay)
-	    ffeste_R806 ();
+	    ffeste_R806 (stmt->u.R806.block);
+	  ffestw_kill (stmt->u.R806.block);
 	  break;
 
 	case FFESTD_stmtidR807_:
@@ -1597,7 +1610,19 @@ ffestd_labeldef_format (ffelab label)
     ffestdStmt_ stmt;
 
     stmt = ffestd_stmt_new_ (FFESTD_stmtidFORMATLABEL_);
+#if 0
+    /* Don't bother with this.  See FORMAT statement.  */
+    /* Prepend FORMAT label instead of appending it, so all the
+       FORMAT label/statement pairs end up at the top of the list.
+       This helps ensure all decls for a block (in the GBE) are
+       known before any executable statements are generated.  */
+    stmt->previous = (ffestdStmt_) &ffestd_stmt_list_.first;
+    stmt->next = ffestd_stmt_list_.first;
+    stmt->next->previous = stmt;
+    stmt->previous->next = stmt;
+#else
     ffestd_stmt_append_ (stmt);
+#endif
     stmt->u.formatlabel.label = label;
   }
 #endif
@@ -2989,13 +3014,7 @@ ffestd_R744 ()
 #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_().  */
+/* ffestd_R745 -- Implicit END WHERE statement.  */
 
 void
 ffestd_R745 (bool ok)
@@ -3011,11 +3030,8 @@ ffestd_R745 (bool ok)
 }
 
 #endif
-/* ffestd_R803 -- Block IF (IF-THEN) statement
-
-   ffestd_R803(construct_name,expr,expr_token);
 
-   Make sure statement is valid here; implement.  */
+/* Block IF (IF-THEN) statement.  */
 
 void
 ffestd_R803 (ffelexToken construct_name UNUSED, ffebld expr)
@@ -3033,6 +3049,7 @@ ffestd_R803 (ffelexToken construct_name UNUSED, ffebld expr)
     ffestd_stmt_append_ (stmt);
     ffestd_subr_line_save_ (stmt);
     stmt->u.R803.pool = ffesta_output_pool;
+    stmt->u.R803.block = ffestw_use (ffestw_stack_top ());
     stmt->u.R803.expr = expr;
     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
   }
@@ -3042,13 +3059,7 @@ ffestd_R803 (ffelexToken construct_name UNUSED, ffebld expr)
   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.  */
+/* ELSE IF statement.  */
 
 void
 ffestd_R804 (ffebld expr, ffelexToken name UNUSED)
@@ -3066,19 +3077,14 @@ ffestd_R804 (ffebld expr, ffelexToken name UNUSED)
     ffestd_stmt_append_ (stmt);
     ffestd_subr_line_save_ (stmt);
     stmt->u.R804.pool = ffesta_output_pool;
+    stmt->u.R804.block = ffestw_use (ffestw_stack_top ());
     stmt->u.R804.expr = expr;
     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
   }
 #endif
 }
 
-/* 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.  */
+/* ELSE statement.  */
 
 void
 ffestd_R805 (ffelexToken name UNUSED)
@@ -3095,13 +3101,12 @@ ffestd_R805 (ffelexToken name UNUSED)
     stmt = ffestd_stmt_new_ (FFESTD_stmtidR805_);
     ffestd_stmt_append_ (stmt);
     ffestd_subr_line_save_ (stmt);
+    stmt->u.R805.block = ffestw_use (ffestw_stack_top ());
   }
 #endif
 }
 
-/* ffestd_R806 -- End an IF-THEN
-
-   ffestd_R806(TRUE);  */
+/* END IF statement.  */
 
 void
 ffestd_R806 (bool ok UNUSED)
@@ -3116,6 +3121,7 @@ ffestd_R806 (bool ok UNUSED)
     stmt = ffestd_stmt_new_ (FFESTD_stmtidR806_);
     ffestd_stmt_append_ (stmt);
     ffestd_subr_line_save_ (stmt);
+    stmt->u.R806.block = ffestw_use (ffestw_stack_top ());
   }
 #endif
 
@@ -4273,7 +4279,24 @@ ffestd_R1001 (ffesttFormatList f)
     ffestdStmt_ stmt;
 
     stmt = ffestd_stmt_new_ (FFESTD_stmtidR1001_);
+#if 0
+    /* Don't bother with this.  After all, things like cilists also are
+       declared midway through code-generation.  Perhaps the only problems
+       the gcc back end has with midway declarations are with stack vars,
+       maybe only with vars that can be put in registers.  Unless/until the
+       need is established, handle FORMAT just like cilists and others; at
+       that point, they'd likely *all* have to be fixed, which would be
+       very painful anyway.  */
+    /* Insert FORMAT statement just after the first item on the
+       statement list, which must be a FORMAT label, which see.  */
+    assert (ffestd_stmt_list_.first->id == FFESTD_stmtidFORMATLABEL_);
+    stmt->previous = ffestd_stmt_list_.first;
+    stmt->next = ffestd_stmt_list_.first->next;
+    stmt->next->previous = stmt;
+    stmt->previous->next = stmt;
+#else
     ffestd_stmt_append_ (stmt);
+#endif
     stmt->u.R1001.str = str;
   }
 #endif
diff --git a/gcc/f/ste.c b/gcc/f/ste.c
index e8c066e..b87f532 100644
--- a/gcc/f/ste.c
+++ b/gcc/f/ste.c
@@ -28,21 +28,6 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
    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. */
 
 #include "proj.h"
@@ -114,8 +99,10 @@ static void ffeste_begin_iterdo_ (ffestw block, tree *tvar, tree *tincr,
 				  ffebld end, ffelexToken end_token,
 				  ffebld incr, ffelexToken incr_token,
 				  const char *msg);
-static void ffeste_end_iterdo_ (tree tvar, tree tincr, tree itersvar);
+static void ffeste_end_iterdo_ (ffestw block, tree tvar, tree tincr,
+				tree itersvar);
 static void ffeste_io_call_ (tree call, bool do_check);
+static void ffeste_io_impdo_ (ffebld impdo, ffelexToken impdo_token);
 static tree ffeste_io_dofio_ (ffebld expr);
 static tree ffeste_io_dolio_ (ffebld expr);
 static tree ffeste_io_douio_ (ffebld expr);
@@ -131,7 +118,23 @@ static tree ffeste_io_cllist_ (bool have_err, ffebld unit_expr,
 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_inlist_ (bool have_err,
+			       ffestpFile *unit_spec,
+			       ffestpFile *file_spec,
+			       ffestpFile *exist_spec,
+			       ffestpFile *open_spec,
+			       ffestpFile *number_spec,
+			       ffestpFile *named_spec,
+			       ffestpFile *name_spec,
+			       ffestpFile *access_spec,
+			       ffestpFile *sequential_spec,
+			       ffestpFile *direct_spec,
+			       ffestpFile *form_spec,
+			       ffestpFile *formatted_spec,
+			       ffestpFile *unformatted_spec,
+			       ffestpFile *recl_spec,
+			       ffestpFile *nextrec_spec,
+			       ffestpFile *blank_spec);
 static tree ffeste_io_olist_ (bool have_err, ffebld unit_expr,
 			      ffestpFile *file_spec,
 			      ffestpFile *stat_spec,
@@ -177,118 +180,325 @@ static void ffeste_subr_file_ (const char *kw, ffestpFile *spec);
 	 || ffeste_statelet_ == FFESTE_stateletITEM_); \
   ffeste_statelet_ = FFESTE_stateletSIMPLE_
 
-#define ffeste_f2c_charnolenspec_(Spec,Exp,Init)			    \
+#define ffeste_f2c_init_charnolen_(Exp,Init,Spec)			      \
   do									      \
     {									      \
-    if (Spec->kw_or_val_present)					      \
-	Exp = ffecom_arg_ptr_to_expr(Spec->u.expr,&ignore);		 \
+      if ((Spec)->kw_or_val_present)					      \
+	Exp = ffecom_arg_ptr_to_const_expr ((Spec)->u.expr, &ignore);	      \
       else								      \
 	Exp = null_pointer_node;					      \
-    if (TREE_CONSTANT(Exp))						      \
-	{								      \
+      if (Exp)								      \
 	Init = Exp;							      \
-	Exp = NULL_TREE;						      \
-	}								      \
       else								      \
 	{								      \
-	Init = null_pointer_node;					      \
-	constantp = FALSE;						      \
+	  Init = null_pointer_node;					      \
+	  constantp = FALSE;						      \
 	}								      \
     } while(0)
 
-#define ffeste_f2c_charspec_(Spec,Exp,Init,Lenexp,Leninit)		    \
+#define ffeste_f2c_init_char_(Exp,Init,Lenexp,Leninit,Spec)		      \
   do									      \
     {									      \
-    if (Spec->kw_or_val_present)					      \
-	Exp = ffecom_arg_ptr_to_expr(Spec->u.expr,&Lenexp);		      \
+      if ((Spec)->kw_or_val_present)					      \
+	Exp = ffecom_arg_ptr_to_const_expr ((Spec)->u.expr, &Lenexp);	      \
       else								      \
 	{								      \
-	Exp = null_pointer_node;					      \
-	Lenexp = ffecom_f2c_ftnlen_zero_node;				      \
+	  Exp = null_pointer_node;					      \
+	  Lenexp = ffecom_f2c_ftnlen_zero_node;				      \
 	}								      \
-    if (TREE_CONSTANT(Exp))						      \
-	{								      \
+      if (Exp)								      \
 	Init = Exp;							      \
-	Exp = NULL_TREE;						      \
+      else								      \
+	{								      \
+	  Init = null_pointer_node;					      \
+	  constantp = FALSE;						      \
 	}								      \
+      if (Lenexp)							      \
+	Leninit = Lenexp;						      \
       else								      \
 	{								      \
-	Init = null_pointer_node;					      \
-	constantp = FALSE;						      \
+	  Leninit = ffecom_f2c_ftnlen_zero_node;			      \
+	  constantp = FALSE;						      \
 	}								      \
-    if ((Lenexp != NULL_TREE) && TREE_CONSTANT(Lenexp))			      \
+    } while(0)
+
+#define ffeste_f2c_init_flag_(Flag,Init)				      \
+  do									      \
+    {									      \
+      Init = convert (ffecom_f2c_flag_type_node,			      \
+		      (Flag) ? integer_one_node : integer_zero_node);	      \
+    } while(0)
+
+#define ffeste_f2c_init_format_(Exp,Init,Spec)				      \
+  do									      \
+    {									      \
+      Exp = ffecom_arg_ptr_to_const_expr ((Spec)->u.expr, NULL);	      \
+      if (Exp)								      \
+	Init = Exp;							      \
+      else								      \
 	{								      \
-	Leninit = Lenexp;						      \
-	Lenexp = NULL_TREE;						      \
+	  Init = null_pointer_node;					      \
+	  constantp = FALSE;						      \
 	}								      \
+    } while(0)
+
+#define ffeste_f2c_init_int_(Exp,Init,Spec)				      \
+  do									      \
+    {									      \
+      if ((Spec)->kw_or_val_present)					      \
+	Exp = ffecom_const_expr ((Spec)->u.expr);			      \
+      else								      \
+	Exp = ffecom_integer_zero_node;					      \
+      if (Exp)								      \
+	Init = Exp;							      \
       else								      \
 	{								      \
-	Leninit = ffecom_f2c_ftnlen_zero_node;				      \
-	constantp = FALSE;						      \
+	  Init = ffecom_integer_zero_node;				      \
+	  constantp = FALSE;						      \
 	}								      \
     } while(0)
 
-#define ffeste_f2c_exp_(Field,Exp)					      \
+#define ffeste_f2c_init_ptrtoint_(Exp,Init,Spec)			      \
   do									      \
     {									      \
-    if (Exp != NULL_TREE)						      \
+      if ((Spec)->kw_or_val_present)					      \
+	Exp = ffecom_ptr_to_const_expr ((Spec)->u.expr);		      \
+      else								      \
+	Exp = null_pointer_node;					      \
+      if (Exp)								      \
+	Init = Exp;							      \
+      else								      \
 	{								      \
-	Exp = ffecom_modify(void_type_node,ffecom_2(COMPONENT_REF,	      \
-	      TREE_TYPE(Field),t,Field),Exp);				      \
-	expand_expr_stmt(Exp);						      \
+	  Init = null_pointer_node;					      \
+	  constantp = FALSE;						      \
 	}								      \
     } while(0)
 
-#define ffeste_f2c_init_(Init)						    \
+#define ffeste_f2c_init_next_(Init)					      \
+  do									      \
+    {									      \
+      TREE_CHAIN (initn) = build_tree_list ((field = TREE_CHAIN (field)),     \
+					    (Init));			      \
+      initn = TREE_CHAIN(initn);					      \
+    } while(0)
+
+#define ffeste_f2c_prepare_charnolen_(Spec,Exp)				      \
   do									      \
     {									      \
-    TREE_CHAIN(initn) = build_tree_list((field = TREE_CHAIN(field)),Init);    \
-    initn = TREE_CHAIN(initn);						      \
+      if (! (Exp))							      \
+        ffecom_prepare_arg_ptr_to_expr ((Spec)->u.expr);		      \
     } 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_prepare_char_(Spec,Exp)				      \
+  do									      \
+    {									      \
+      if (! (Exp))							      \
+        ffecom_prepare_arg_ptr_to_expr ((Spec)->u.expr);		      \
+    } while(0)
 
-#define ffeste_f2c_intspec_(Spec,Exp,Init)				      \
+#define ffeste_f2c_prepare_format_(Spec,Exp)				      \
   do									      \
     {									      \
-    if (Spec->kw_or_val_present)					      \
-	Exp = ffecom_expr(Spec->u.expr);				      \
-      else								      \
-	Exp = ffecom_integer_zero_node;					      \
-    if (TREE_CONSTANT(Exp))						      \
+      if (! (Exp))							      \
+        ffecom_prepare_arg_ptr_to_expr ((Spec)->u.expr);		      \
+    } while(0)
+
+#define ffeste_f2c_prepare_int_(Spec,Exp)				      \
+  do									      \
+    {									      \
+      if (! (Exp))							      \
+        ffecom_prepare_expr ((Spec)->u.expr);				      \
+    } while(0)
+
+#define ffeste_f2c_prepare_ptrtoint_(Spec,Exp)				      \
+  do									      \
+    {									      \
+      if (! (Exp))							      \
+        ffecom_prepare_ptr_to_expr ((Spec)->u.expr);			      \
+    } while(0)
+
+#define ffeste_f2c_compile_(Field,Exp)					      \
+  do									      \
+    {									      \
+      tree exz;								      \
+      if ((Exp))							      \
 	{								      \
-	Init = Exp;							      \
-	Exp = NULL_TREE;						      \
+	  exz = ffecom_modify (void_type_node,				      \
+			       ffecom_2 (COMPONENT_REF, TREE_TYPE (Field),    \
+					 t, (Field)),			      \
+			       (Exp));					      \
+	  expand_expr_stmt (exz);					      \
 	}								      \
-      else								      \
+    } while(0)
+
+#define ffeste_f2c_compile_charnolen_(Field,Spec,Exp)			      \
+  do									      \
+    {									      \
+      tree exq;								      \
+      if (! (Exp))							      \
 	{								      \
-	Init = ffecom_integer_zero_node;				      \
-	constantp = FALSE;						      \
+	  exq = ffecom_arg_ptr_to_expr ((Spec)->u.expr, &ignore);	      \
+	  ffeste_f2c_compile_ ((Field), exq);				      \
 	}								      \
     } while(0)
 
-#define ffeste_f2c_ptrtointspec_(Spec,Exp,Init)				    \
+#define ffeste_f2c_compile_char_(Field,Lenfield,Spec,Exp,Lenexp)	      \
   do									      \
     {									      \
-    if (Spec->kw_or_val_present)					      \
-	Exp = ffecom_ptr_to_expr(Spec->u.expr);				 \
-      else								      \
-	Exp = null_pointer_node;					      \
-    if (TREE_CONSTANT(Exp))						      \
+      tree exq = (Exp);							      \
+      tree lenexq = (Lenexp);						      \
+      int need_exq = (! exq);						      \
+      int need_lenexq = (! lenexq); 					      \
+      if (need_exq || need_lenexq)					      \
 	{								      \
-	Init = Exp;							      \
-	Exp = NULL_TREE;						      \
+	  exq = ffecom_arg_ptr_to_expr ((Spec)->u.expr, &lenexq);	      \
+	  if (need_exq)							      \
+	    ffeste_f2c_compile_ ((Field), exq);				      \
+	  if (need_lenexq)						      \
+	    ffeste_f2c_compile_ ((Lenfield), lenexq);			      \
 	}								      \
-      else								      \
+    } while(0)
+
+#define ffeste_f2c_compile_format_(Field,Spec,Exp)			      \
+  do									      \
+    {									      \
+      tree exq;								      \
+      if (! (Exp))							      \
 	{								      \
-	Init = null_pointer_node;					      \
-	constantp = FALSE;						      \
+	  exq = ffecom_arg_ptr_to_expr ((Spec)->u.expr, NULL);		      \
+	  ffeste_f2c_compile_ ((Field), exq);				      \
+	}								      \
+    } while(0)
+
+#define ffeste_f2c_compile_int_(Field,Spec,Exp)				      \
+  do									      \
+    {									      \
+      tree exq;								      \
+      if (! (Exp))							      \
+	{								      \
+	  exq = ffecom_expr ((Spec)->u.expr);				      \
+	  ffeste_f2c_compile_ ((Field), exq);				      \
+	}								      \
+    } while(0)
+
+#define ffeste_f2c_compile_ptrtoint_(Field,Spec,Exp)			      \
+  do									      \
+    {									      \
+      tree exq;								      \
+      if (! (Exp))							      \
+	{								      \
+	  exq = ffecom_ptr_to_expr ((Spec)->u.expr);			      \
+	  ffeste_f2c_compile_ ((Field), exq);				      \
 	}								      \
     } while(0)
 
+/* Start a Fortran block.  */
+
+#ifdef ENABLE_CHECKING
+
+typedef struct gbe_block
+{
+  struct gbe_block *outer;
+  ffestw block;
+  int lineno;
+  char *input_filename;
+  bool is_stmt;
+} *gbe_block;
+
+gbe_block ffeste_top_block_ = NULL;
+
+static void
+ffeste_start_block_ (ffestw block)
+{
+  gbe_block b = xmalloc (sizeof (*b));
+
+  b->outer = ffeste_top_block_;
+  b->block = block;
+  b->lineno = lineno;
+  b->input_filename = input_filename;
+  b->is_stmt = FALSE;
+
+  ffeste_top_block_ = b;
+
+  ffecom_start_compstmt ();
+}
+
+/* End a Fortran block.  */
+
+static void
+ffeste_end_block_ (ffestw block)
+{
+  gbe_block b = ffeste_top_block_;
+
+  assert (b);
+  assert (! b->is_stmt);
+  assert (b->block == block);
+  assert (! b->is_stmt);
+
+  ffeste_top_block_ = b->outer;
+
+  free (b);
+
+  clear_momentary ();
+
+  ffecom_end_compstmt ();
+}
+
+/* Start a Fortran statement.
+
+   Starts a back-end block, so temporaries can be managed, clean-ups
+   properly handled, etc.  Nesting of statements *is* allowed -- the
+   handling of I/O items, even implied-DO I/O lists, within a READ,
+   PRINT, or WRITE statement is one example.  */
+
+static void
+ffeste_start_stmt_(void)
+{
+  gbe_block b = xmalloc (sizeof (*b));
+
+  b->outer = ffeste_top_block_;
+  b->block = NULL;
+  b->lineno = lineno;
+  b->input_filename = input_filename;
+  b->is_stmt = TRUE;
+
+  ffeste_top_block_ = b;
+
+  ffecom_start_compstmt ();
+}
+
+/* End a Fortran statement.  */
+
+static void
+ffeste_end_stmt_(void)
+{
+  gbe_block b = ffeste_top_block_;
+
+  assert (b);
+  assert (b->is_stmt);
+
+  ffeste_top_block_ = b->outer;
+
+  free (b);
+
+  clear_momentary ();
+
+  ffecom_end_compstmt ();
+}
+
+#else  /* ! defined (ENABLE_CHECKING) */
+
+#define ffeste_start_block_(b) ffecom_start_compstmt ()
+#define ffeste_end_block_(b)	\
+  do				\
+    {				\
+      clear_momentary ();	\
+      ffecom_end_compstmt ();	\
+    } while(0)
+#define ffeste_start_stmt_() ffeste_start_block_(NULL)
+#define ffeste_end_stmt_() ffeste_end_block_(NULL)
+
+#endif  /* ! defined (ENABLE_CHECKING) */
 
 /* Begin an iterative DO loop.  Pass the block to start if applicable.
 
@@ -311,20 +521,40 @@ ffeste_begin_iterdo_ (ffestw block, tree *xtvar, tree *xtincr,
   tree tincr;
   tree tincr_saved;
   tree niters;
+  struct nesting *expanded_loop;
+
+  /* Want to have tvar, tincr, and niters for the whole loop body. */
+
+  if (block)
+    ffeste_start_block_ (block);
+  else
+    ffeste_start_stmt_ ();
+
+  niters = ffecom_make_tempvar (block ? "do" : "impdo",
+				ffecom_integer_type_node,
+				FFETARGET_charactersizeNONE, -1);
 
-  push_momentary ();		/* Want to save these throughout the loop. */
+  ffecom_prepare_expr (incr);
+  ffecom_prepare_expr_rw (NULL_TREE, var);
 
-  tvar = ffecom_expr_rw (var);
+  ffecom_prepare_end ();
+
+  tvar = ffecom_expr_rw (NULL_TREE, var);
   tincr = ffecom_expr (incr);
 
   if (TREE_CODE (tvar) == ERROR_MARK
       || TREE_CODE (tincr) == ERROR_MARK)
     {
       if (block)
-	ffestw_set_do_tvar (block, error_mark_node);
+	{
+	  ffeste_end_block_ (block);
+	  ffestw_set_do_tvar (block, error_mark_node);
+	}
       else
-	*xtvar = error_mark_node;
-      pop_momentary ();
+	{
+	  ffeste_end_stmt_ ();
+	  *xtvar = error_mark_node;
+	}
       return;
     }
 
@@ -342,7 +572,16 @@ ffeste_begin_iterdo_ (ffestw block, tree *xtvar, tree *xtincr,
 
   tincr_saved = ffecom_save_tree (tincr);
 
-  push_momentary ();		/* Want to discard the rest after the loop. */
+  preserve_momentary ();
+
+  /* Want to have tstart, tend for just this statement. */
+
+  ffeste_start_stmt_ ();
+
+  ffecom_prepare_expr (start);
+  ffecom_prepare_expr (end);
+
+  ffecom_prepare_end ();
 
   tstart = ffecom_expr (start);
   tend = ffecom_expr (end);
@@ -350,20 +589,26 @@ ffeste_begin_iterdo_ (ffestw block, tree *xtvar, tree *xtincr,
   if (TREE_CODE (tstart) == ERROR_MARK
       || TREE_CODE (tend) == ERROR_MARK)
     {
+      ffeste_end_stmt_ ();
+
       if (block)
-	ffestw_set_do_tvar (block, error_mark_node);
+	{
+	  ffeste_end_block_ (block);
+	  ffestw_set_do_tvar (block, error_mark_node);
+	}
       else
-	*xtvar = error_mark_node;
-      pop_momentary ();
-      pop_momentary ();
+	{
+	  ffeste_end_stmt_ ();
+	  *xtvar = error_mark_node;
+	}
       return;
     }
 
-  {				/* For warnings only, nothing else
-				   happens here.  */
+  /* For warnings only, nothing else happens here.  */
+  {
     tree try;
 
-    if (!ffe_is_onetrip ())
+    if (! ffe_is_onetrip ())
       {
 	try = ffecom_2 (MINUS_EXPR, TREE_TYPE (tvar),
 			tend,
@@ -425,7 +670,7 @@ ffeste_begin_iterdo_ (ffestw block, tree *xtvar, tree *xtincr,
 		   tend,
 		   tstart);
 
-  if (!ffe_is_onetrip ())
+  if (! ffe_is_onetrip ())
     {
       expr = ffecom_2 (PLUS_EXPR, TREE_TYPE (expr),
 		       expr,
@@ -457,21 +702,22 @@ ffeste_begin_iterdo_ (ffestw block, tree *xtvar, tree *xtincr,
     expr = convert (ffecom_integer_type_node, expr);
 #endif
 
-  niters = ffecom_push_tempvar (TREE_TYPE (expr),
-				FFETARGET_charactersizeNONE, -1, FALSE);
+  assert (TYPE_MAIN_VARIANT (TREE_TYPE (niters))
+	  == TYPE_MAIN_VARIANT (TREE_TYPE (expr)));
+
   expr = ffecom_modify (void_type_node, niters, expr);
   expand_expr_stmt (expr);
 
   expr = ffecom_modify (void_type_node, tvar, tstart);
   expand_expr_stmt (expr);
 
-  if (block == NULL)
-    expand_start_loop_continue_elsewhere (0);
-  else
-    ffestw_set_do_hook (block,
-			expand_start_loop_continue_elsewhere (1));
+  ffeste_end_stmt_ ();
 
-  if (!ffe_is_onetrip ())
+  expanded_loop = expand_start_loop_continue_elsewhere (!! block);
+  if (block)
+    ffestw_set_do_hook (block, expanded_loop);
+
+  if (! ffe_is_onetrip ())
     {
       expr = ffecom_truth_value
 	(ffecom_2 (GE_EXPR, integer_type_node,
@@ -486,21 +732,18 @@ ffeste_begin_iterdo_ (ffestw block, tree *xtvar, tree *xtincr,
       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
+  if (block)
     {
       ffestw_set_do_tvar (block, tvar);
       ffestw_set_do_incr_saved (block, tincr_saved);
       ffestw_set_do_count_var (block, niters);
     }
+  else
+    {
+      *xtvar = tvar;
+      *xtincr = tincr_saved;
+      *xitersvar = niters;
+    }
 }
 
 #endif
@@ -510,7 +753,7 @@ ffeste_begin_iterdo_ (ffestw block, tree *xtvar, tree *xtincr,
 
 #if FFECOM_targetCURRENT == FFECOM_targetGCC
 static void
-ffeste_end_iterdo_ (tree tvar, tree tincr, tree itersvar)
+ffeste_end_iterdo_ (ffestw block, tree tvar, tree tincr, tree itersvar)
 {
   tree expr;
   tree niters = itersvar;
@@ -520,6 +763,8 @@ ffeste_end_iterdo_ (tree tvar, tree tincr, tree itersvar)
 
   expand_loop_continue_here ();
 
+  ffeste_start_stmt_ ();
+
   if (ffe_is_onetrip ())
     {
       expr = ffecom_truth_value
@@ -540,27 +785,21 @@ ffeste_end_iterdo_ (tree tvar, tree tincr, tree itersvar)
 				  tvar,
 				  tincr));
   expand_expr_stmt (expr);
-  expand_end_loop ();
 
-  ffecom_pop_tempvar (itersvar);	/* Free #iters var. */
+  /* Lose the stuff we just built. */
+  ffeste_end_stmt_ ();
 
-  clear_momentary ();
-  pop_momentary ();		/* Lose the stuff we just built. */
+  expand_end_loop ();
 
-  clear_momentary ();
-  pop_momentary ();		/* Lose the tvar and incr_saved trees. */
+  /* Lose the tvar and incr_saved trees. */
+  if (block)
+    ffeste_end_block_ (block);
+  else
+    ffeste_end_stmt_ ();
 }
-
 #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_;".  */
+/* Generate call to run-time I/O routine.  */
 
 #if FFECOM_targetCURRENT == FFECOM_targetGCC
 static void
@@ -570,15 +809,13 @@ ffeste_io_call_ (tree call, bool do_check)
 
   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);
-    }
+    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))
+  if (! do_check
+      || ffeste_io_abort_ == NULL_TREE
+      || TREE_CODE (ffeste_io_abort_) == ERROR_MARK)
     return;
 
   /* Generate optional test. */
@@ -587,13 +824,96 @@ ffeste_io_call_ (tree call, bool do_check)
   expand_goto (ffeste_io_abort_);
   expand_end_cond ();
 }
+#endif
+
+/* Handle implied-DO in I/O list.
+
+   Expands code to start up the DO loop.  Then for each item in the
+   DO loop, handles appropriately (possibly including recursively calling
+   itself).  Then expands code to end the DO loop.  */
+
+#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;
+  ffebld item;
+  tree tvar;
+  tree tincr;
+  tree titervar;
+
+  if (incr == NULL)
+    {
+      incr = ffebld_new_conter (ffebld_constant_new_integerdefault_val (1));
+      ffebld_set_info (incr, ffeinfo_new
+		       (FFEINFO_basictypeINTEGER,
+			FFEINFO_kindtypeINTEGERDEFAULT,
+			0,
+			FFEINFO_kindENTITY,
+			FFEINFO_whereCONSTANT,
+			FFETARGET_charactersizeNONE));
+    }
 
+  /* Start the DO loop.  */
+
+  start = ffeexpr_convert_expr (start, impdo_token, var, impdo_token,
+				FFEEXPR_contextLET);
+  end = ffeexpr_convert_expr (end, impdo_token, var, impdo_token,
+			      FFEEXPR_contextLET);
+  incr = ffeexpr_convert_expr (incr, impdo_token, var, impdo_token,
+			       FFEEXPR_contextLET);
+
+  ffeste_begin_iterdo_ (NULL, &tvar, &tincr, &titervar, var,
+			start, impdo_token,
+			end, impdo_token,
+			incr, impdo_token,
+			"Implied DO loop");
+
+  /* Handle the list of items.  */
+
+  for (list = ffebld_left (impdo); list != NULL; list = ffebld_trail (list))
+    {
+      item = ffebld_head (list);
+      if (item == NULL)
+	continue;
+
+      /* Strip parens off items such as in "READ *,(A)".  This is really a bug
+	 in the user's code, but I've been told lots of code does this.  */
+      while (ffebld_op (item) == FFEBLD_opPAREN)
+	item = ffebld_left (item);
+
+      if (ffebld_op (item) == FFEBLD_opANY)
+	continue;
+
+      if (ffebld_op (item) == FFEBLD_opIMPDO)
+	ffeste_io_impdo_ (item, impdo_token);
+      else
+	{
+	  ffeste_start_stmt_ ();
+
+	  ffecom_prepare_arg_ptr_to_expr (item);
+
+	  ffecom_prepare_end ();
+
+	  ffeste_io_call_ ((*ffeste_io_driver_) (item), TRUE);
+
+	  ffeste_end_stmt_ ();
+	}
+    }
+
+  /* Generate end of implied-do construct. */
+
+  ffeste_end_iterdo_ (NULL, tvar, tincr, titervar);
+}
 #endif
-/* ffeste_io_dofio_ -- Generate call to do_fio for formatted I/O item
 
-   ffebld expr;
-   tree call;
-   call = ffeste_io_dofio_(expr);
+/* I/O driver for formatted I/O item (do_fio)
 
    Returns a tree for a CALL_EXPR to the do_fio function, which handles
    a formatted I/O list item, along with the appropriate arguments for
@@ -629,16 +949,11 @@ ffeste_io_dofio_ (ffebld expr)
   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;
-    }
+    return error_mark_node;
 
   if (size == NULL_TREE)	/* Already filled in for CHARACTER type. */
     {				/* "(ftnlen) sizeof(type)" */
@@ -655,14 +970,15 @@ ffeste_io_dofio_ (ffebld expr)
       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;
+  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);
+				 TYPE_SIZE (TREE_TYPE (TREE_TYPE (variable))),
+				 size);
       num_elements = size_binop (CEIL_DIV_EXPR,
 				 num_elements,
 				 size_int (TYPE_PRECISION
@@ -681,17 +997,11 @@ ffeste_io_dofio_ (ffebld expr)
   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);
+  return ffecom_call_gfrt (FFECOM_gfrtDOFIO, arglist, NULL_TREE);
 }
 
 #endif
-/* ffeste_io_dolio_ -- Generate call to do_lio for list-directed I/O item
-
-   ffebld expr;
-   tree call;
-   call = ffeste_io_dolio_(expr);
+/* I/O driver for list-directed I/O item (do_lio)
 
    Returns a tree for a CALL_EXPR to the do_lio function, which handles
    a list-directed I/O list item, along with the appropriate arguments for
@@ -720,8 +1030,6 @@ ffeste_io_dolio_ (ffebld expr)
       || (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);
@@ -736,10 +1044,7 @@ ffeste_io_dolio_ (ffebld expr)
   if ((type_id == error_mark_node)
       || (variable == error_mark_node)
       || (size == error_mark_node))
-    {
-      ffecom_pop_calltemps ();
-      return error_mark_node;
-    }
+    return error_mark_node;
 
   if (size == NULL_TREE)	/* Already filled in for CHARACTER type. */
     {				/* "(ftnlen) sizeof(type)" */
@@ -756,13 +1061,14 @@ ffeste_io_dolio_ (ffebld expr)
       size = convert (ffecom_f2c_ftnlen_type_node, size);
     }
 
-  if ((ffeinfo_rank (ffebld_info (expr)) == 0)
-      || (TREE_CODE (TREE_TYPE (TREE_TYPE (variable))) != ARRAY_TYPE))
+  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);
+				 TYPE_SIZE (TREE_TYPE (TREE_TYPE (variable))),
+				 size);
       num_elements = size_binop (CEIL_DIV_EXPR,
 				 num_elements,
 				 size_int (TYPE_PRECISION
@@ -783,17 +1089,11 @@ ffeste_io_dolio_ (ffebld expr)
   TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (arglist)))
     = build_tree_list (NULL_TREE, size);
 
-  ffecom_pop_calltemps ();
-
-  return ffecom_call_gfrt (FFECOM_gfrtDOLIO, arglist);
+  return ffecom_call_gfrt (FFECOM_gfrtDOLIO, arglist, NULL_TREE);
 }
 
 #endif
-/* ffeste_io_douio_ -- Generate call to do_uio for unformatted I/O item
-
-   ffebld expr;
-   tree call;
-   call = ffeste_io_douio_(expr);
+/* I/O driver for unformatted I/O item (do_uio)
 
    Returns a tree for a CALL_EXPR to the do_uio function, which handles
    an unformatted I/O list item, along with the appropriate arguments for
@@ -829,16 +1129,11 @@ ffeste_io_douio_ (ffebld expr)
   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;
-    }
+    return error_mark_node;
 
   if (size == NULL_TREE)	/* Already filled in for CHARACTER type. */
     {				/* "(ftnlen) sizeof(type)" */
@@ -855,14 +1150,15 @@ ffeste_io_douio_ (ffebld expr)
       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;
+  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);
+				 TYPE_SIZE (TREE_TYPE (TREE_TYPE (variable))),
+				 size);
       num_elements = size_binop (CEIL_DIV_EXPR, num_elements,
 				 size_int (TYPE_PRECISION
 					   (char_type_node)));
@@ -880,21 +1176,24 @@ ffeste_io_douio_ (ffebld expr)
   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);
+  return ffecom_call_gfrt (FFECOM_gfrtDOUIO, arglist, NULL_TREE);
 }
 
 #endif
-/* ffeste_io_ialist_ -- Make arglist with ptr to B/E/R control list
-
-   tree arglist;
-   arglist = ffeste_io_ialist_(...);
+/* Make arglist with ptr to BACKSPACE/ENDFILE/REWIND control list.
 
    Returns a tree suitable as an argument list containing a pointer to
    a BACKSPACE/ENDFILE/REWIND control list.  First, generates that control
    list, if necessary, along with any static and run-time initializations
-   that are needed as specified by the arguments to this function.  */
+   that are needed as specified by the arguments to this function.
+
+   Must ensure that all expressions are prepared before being evaluated,
+   for any whose evaluation might result in the generation of temporaries.
+
+   Note that this means this function causes a transition, within the
+   current block being code-generated via the back end, from the
+   declaration of variables (temporaries) to the expanding of expressions,
+   statements, etc.  */
 
 #if FFECOM_targetCURRENT == FFECOM_targetGCC
 static tree
@@ -938,23 +1237,23 @@ ffeste_io_ialist_ (bool have_err,
       f2c_alist_struct = ref;
     }
 
-  ffeste_f2c_flagspec_ (have_err, errinit);
+  /* Try to do as much compile-time initialization of the structure
+     as possible, to save run time.  */
+
+  ffeste_f2c_init_flag_ (have_err, errinit);
 
   switch (unit)
     {
     case FFESTV_unitNONE:
     case FFESTV_unitASTERISK:
       unitinit = build_int_2 (unit_dflt, 0);
-      unitexp = NULL_TREE;
+      unitexp = unitinit;
       break;
 
     case FFESTV_unitINTEXPR:
-      unitexp = ffecom_expr (unit_expr);
-      if (TREE_CONSTANT (unitexp))
-	{
-	  unitinit = unitexp;
-	  unitexp = NULL_TREE;
-	}
+      unitexp = ffecom_const_expr (unit_expr);
+      if (unitexp)
+	unitinit = unitexp;
       else
 	{
 	  unitinit = ffecom_integer_zero_node;
@@ -964,14 +1263,14 @@ ffeste_io_ialist_ (bool have_err,
 
     default:
       assert ("bad unit spec" == NULL);
-      unitexp = NULL_TREE;
       unitinit = ffecom_integer_zero_node;
+      unitexp = unitinit;
       break;
     }
 
   inits = build_tree_list ((field = TYPE_FIELDS (f2c_alist_struct)), errinit);
   initn = inits;
-  ffeste_f2c_init_ (unitinit);
+  ffeste_f2c_init_next_ (unitinit);
 
   inits = build (CONSTRUCTOR, f2c_alist_struct, NULL_TREE, inits);
   TREE_CONSTANT (inits) = constantp ? 1 : 0;
@@ -989,7 +1288,20 @@ ffeste_io_ialist_ (bool have_err,
 
   resume_momentary (yes);
 
-  ffeste_f2c_exp_ (unitfield, unitexp);
+  /* Prepare run-time expressions.  */
+
+  if (! unitexp)
+    ffecom_prepare_expr (unit_expr);
+
+  ffecom_prepare_end ();
+
+  /* Now evaluate run-time expressions as needed.  */
+
+  if (! unitexp)
+    {
+      unitexp = ffecom_expr (unit_expr);
+      ffeste_f2c_compile_ (unitfield, unitexp);
+    }
 
   ttype = build_pointer_type (TREE_TYPE (t));
   t = ffecom_1 (ADDR_EXPR, ttype, t);
@@ -1000,15 +1312,20 @@ ffeste_io_ialist_ (bool have_err,
 }
 
 #endif
-/* ffeste_io_cilist_ -- Make arglist with ptr to external I/O control list
-
-   tree arglist;
-   arglist = ffeste_io_cilist_(...);
+/* Make arglist with ptr to external-I/O control list.
 
    Returns a tree suitable as an argument list containing a pointer to
-   an external-file I/O control list.  First, generates that control
+   an external-I/O control list.  First, generates that control
    list, if necessary, along with any static and run-time initializations
-   that are needed as specified by the arguments to this function.  */
+   that are needed as specified by the arguments to this function.
+
+   Must ensure that all expressions are prepared before being evaluated,
+   for any whose evaluation might result in the generation of temporaries.
+
+   Note that this means this function causes a transition, within the
+   current block being code-generated via the back end, from the
+   declaration of variables (temporaries) to the expanding of expressions,
+   statements, etc.  */
 
 #if FFECOM_targetCURRENT == FFECOM_targetGCC
 static tree
@@ -1063,23 +1380,23 @@ ffeste_io_cilist_ (bool have_err,
       f2c_cilist_struct = ref;
     }
 
-  ffeste_f2c_flagspec_ (have_err, errinit);
+  /* Try to do as much compile-time initialization of the structure
+     as possible, to save run time.  */
+
+  ffeste_f2c_init_flag_ (have_err, errinit);
 
   switch (unit)
     {
     case FFESTV_unitNONE:
     case FFESTV_unitASTERISK:
       unitinit = build_int_2 (unit_dflt, 0);
-      unitexp = NULL_TREE;
+      unitexp = unitinit;
       break;
 
     case FFESTV_unitINTEXPR:
-      unitexp = ffecom_expr (unit_expr);
-      if (TREE_CONSTANT (unitexp))
-	{
-	  unitinit = unitexp;
-	  unitexp = NULL_TREE;
-	}
+      unitexp = ffecom_const_expr (unit_expr);
+      if (unitexp)
+	unitinit = unitexp;
       else
 	{
 	  unitinit = ffecom_integer_zero_node;
@@ -1089,8 +1406,8 @@ ffeste_io_cilist_ (bool have_err,
 
     default:
       assert ("bad unit spec" == NULL);
-      unitexp = NULL_TREE;
       unitinit = ffecom_integer_zero_node;
+      unitexp = unitinit;
       break;
     }
 
@@ -1098,11 +1415,11 @@ ffeste_io_cilist_ (bool have_err,
     {
     case FFESTV_formatNONE:
       formatinit = null_pointer_node;
-      formatexp = NULL_TREE;
+      formatexp = formatinit;
       break;
 
     case FFESTV_formatLABEL:
-      formatexp = NULL_TREE;
+      formatexp = error_mark_node;
       formatinit = ffecom_lookup_label (format_spec->u.label);
       if ((formatinit == NULL_TREE)
 	  || (TREE_CODE (formatinit) == ERROR_MARK))
@@ -1114,12 +1431,9 @@ ffeste_io_cilist_ (bool have_err,
       break;
 
     case FFESTV_formatCHAREXPR:
-      formatexp = ffecom_arg_ptr_to_expr (format_spec->u.expr, NULL);
-      if (TREE_CONSTANT (formatexp))
-	{
-	  formatinit = formatexp;
-	  formatexp = NULL_TREE;
-	}
+      formatexp = ffecom_arg_ptr_to_const_expr (format_spec->u.expr, NULL);
+      if (formatexp)
+	formatinit = formatexp;
       else
 	{
 	  formatinit = null_pointer_node;
@@ -1129,7 +1443,7 @@ ffeste_io_cilist_ (bool have_err,
 
     case FFESTV_formatASTERISK:
       formatinit = null_pointer_node;
-      formatexp = NULL_TREE;
+      formatexp = formatinit;
       break;
 
     case FFESTV_formatINTEXPR:
@@ -1143,27 +1457,24 @@ ffeste_io_cilist_ (bool have_err,
 
     case FFESTV_formatNAMELIST:
       formatinit = ffecom_expr (format_spec->u.expr);
-      formatexp = NULL_TREE;
+      formatexp = formatinit;
       break;
 
     default:
       assert ("bad format spec" == NULL);
-      formatexp = NULL_TREE;
       formatinit = integer_zero_node;
+      formatexp = formatinit;
       break;
     }
 
-  ffeste_f2c_flagspec_ (have_end, endinit);
+  ffeste_f2c_init_flag_ (have_end, endinit);
 
   if (rec)
-    recexp = ffecom_expr (rec_expr);
+    recexp = ffecom_const_expr (rec_expr);
   else
     recexp = ffecom_integer_zero_node;
-  if (TREE_CONSTANT (recexp))
-    {
-      recinit = recexp;
-      recexp = NULL_TREE;
-    }
+  if (recexp)
+    recinit = recexp;
   else
     {
       recinit = ffecom_integer_zero_node;
@@ -1172,10 +1483,10 @@ ffeste_io_cilist_ (bool have_err,
 
   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);
+  ffeste_f2c_init_next_ (unitinit);
+  ffeste_f2c_init_next_ (endinit);
+  ffeste_f2c_init_next_ (formatinit);
+  ffeste_f2c_init_next_ (recinit);
 
   inits = build (CONSTRUCTOR, f2c_cilist_struct, NULL_TREE, inits);
   TREE_CONSTANT (inits) = constantp ? 1 : 0;
@@ -1193,9 +1504,40 @@ ffeste_io_cilist_ (bool have_err,
 
   resume_momentary (yes);
 
-  ffeste_f2c_exp_ (unitfield, unitexp);
-  ffeste_f2c_exp_ (formatfield, formatexp);
-  ffeste_f2c_exp_ (recfield, recexp);
+  /* Prepare run-time expressions.  */
+
+  if (! unitexp)
+    ffecom_prepare_expr (unit_expr);
+
+  if (! formatexp)
+    ffecom_prepare_arg_ptr_to_expr (format_spec->u.expr);
+
+  if (! recexp)
+    ffecom_prepare_expr (rec_expr);
+
+  ffecom_prepare_end ();
+
+  /* Now evaluate run-time expressions as needed.  */
+
+  if (! unitexp)
+    {
+      unitexp = ffecom_expr (unit_expr);
+      ffeste_f2c_compile_ (unitfield, unitexp);
+    }
+
+  if (! formatexp)
+    {
+      formatexp = ffecom_arg_ptr_to_expr (format_spec->u.expr, NULL);
+      ffeste_f2c_compile_ (formatfield, formatexp);
+    }
+  else if (format == FFESTV_formatINTEXPR)
+    ffeste_f2c_compile_ (formatfield, formatexp);
+
+  if (! recexp)
+    {
+      recexp = ffecom_expr (rec_expr);
+      ffeste_f2c_compile_ (recfield, recexp);
+    }
 
   ttype = build_pointer_type (TREE_TYPE (t));
   t = ffecom_1 (ADDR_EXPR, ttype, t);
@@ -1206,15 +1548,20 @@ ffeste_io_cilist_ (bool have_err,
 }
 
 #endif
-/* ffeste_io_cllist_ -- Make arglist with ptr to CLOSE control list
-
-   tree arglist;
-   arglist = ffeste_io_cllist_(...);
+/* Make arglist with ptr to CLOSE control list.
 
    Returns a tree suitable as an argument list containing a pointer to
    a CLOSE-statement control list.  First, generates that control
    list, if necessary, along with any static and run-time initializations
-   that are needed as specified by the arguments to this function.  */
+   that are needed as specified by the arguments to this function.
+
+   Must ensure that all expressions are prepared before being evaluated,
+   for any whose evaluation might result in the generation of temporaries.
+
+   Note that this means this function causes a transition, within the
+   current block being code-generated via the back end, from the
+   declaration of variables (temporaries) to the expanding of expressions,
+   statements, etc.  */
 
 #if FFECOM_targetCURRENT == FFECOM_targetGCC
 static tree
@@ -1260,26 +1607,26 @@ ffeste_io_cllist_ (bool have_err,
       f2c_close_struct = ref;
     }
 
-  ffeste_f2c_flagspec_ (have_err, errinit);
+  /* Try to do as much compile-time initialization of the structure
+     as possible, to save run time.  */
 
-  unitexp = ffecom_expr (unit_expr);
-  if (TREE_CONSTANT (unitexp))
-    {
-      unitinit = unitexp;
-      unitexp = NULL_TREE;
-    }
+  ffeste_f2c_init_flag_ (have_err, errinit);
+
+  unitexp = ffecom_const_expr (unit_expr);
+  if (unitexp)
+    unitinit = unitexp;
   else
     {
       unitinit = ffecom_integer_zero_node;
       constantp = FALSE;
     }
 
-  ffeste_f2c_charnolenspec_ (stat_spec, statexp, statinit);
+  ffeste_f2c_init_charnolen_ (statexp, statinit, stat_spec);
 
   inits = build_tree_list ((field = TYPE_FIELDS (f2c_close_struct)), errinit);
   initn = inits;
-  ffeste_f2c_init_ (unitinit);
-  ffeste_f2c_init_ (statinit);
+  ffeste_f2c_init_next_ (unitinit);
+  ffeste_f2c_init_next_ (statinit);
 
   inits = build (CONSTRUCTOR, f2c_close_struct, NULL_TREE, inits);
   TREE_CONSTANT (inits) = constantp ? 1 : 0;
@@ -1297,8 +1644,25 @@ ffeste_io_cllist_ (bool have_err,
 
   resume_momentary (yes);
 
-  ffeste_f2c_exp_ (unitfield, unitexp);
-  ffeste_f2c_exp_ (statfield, statexp);
+  /* Prepare run-time expressions.  */
+
+  if (! unitexp)
+    ffecom_prepare_expr (unit_expr);
+
+  if (! statexp)
+    ffecom_prepare_arg_ptr_to_expr (stat_spec->u.expr);
+
+  ffecom_prepare_end ();
+
+  /* Now evaluate run-time expressions as needed.  */
+
+  if (! unitexp)
+    {
+      unitexp = ffecom_expr (unit_expr);
+      ffeste_f2c_compile_ (unitfield, unitexp);
+    }
+
+  ffeste_f2c_compile_charnolen_ (statfield, stat_spec, statexp);
 
   ttype = build_pointer_type (TREE_TYPE (t));
   t = ffecom_1 (ADDR_EXPR, ttype, t);
@@ -1309,15 +1673,20 @@ ffeste_io_cllist_ (bool have_err,
 }
 
 #endif
-/* ffeste_io_icilist_ -- Make arglist with ptr to internal I/O control list
-
-   tree arglist;
-   arglist = ffeste_io_icilist_(...);
+/* Make arglist with ptr to internal-I/O control list.
 
    Returns a tree suitable as an argument list containing a pointer to
-   an internal-file I/O control list.  First, generates that control
+   an internal-I/O control list.  First, generates that control
    list, if necessary, along with any static and run-time initializations
-   that are needed as specified by the arguments to this function.  */
+   that are needed as specified by the arguments to this function.
+
+   Must ensure that all expressions are prepared before being evaluated,
+   for any whose evaluation might result in the generation of temporaries.
+
+   Note that this means this function causes a transition, within the
+   current block being code-generated via the back end, from the
+   declaration of variables (temporaries) to the expanding of expressions,
+   statements, etc.  */
 
 #if FFECOM_targetCURRENT == FFECOM_targetGCC
 static tree
@@ -1371,48 +1740,54 @@ ffeste_io_icilist_ (bool have_err,
       f2c_icilist_struct = ref;
     }
 
-  ffeste_f2c_flagspec_ (have_err, errinit);
+  /* Try to do as much compile-time initialization of the structure
+     as possible, to save run time.  */
 
-  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;
-    }
+  ffeste_f2c_init_flag_ (have_err, errinit);
+
+  unitexp = ffecom_arg_ptr_to_const_expr (unit_expr, &unitlenexp);
+  if (unitexp)
+    unitinit = unitexp;
   else
     {
       unitinit = null_pointer_node;
       constantp = FALSE;
     }
-  if ((unitlenexp != NULL_TREE) && TREE_CONSTANT (unitlenexp))
-    {
-      unitleninit = unitlenexp;
-      unitlenexp = NULL_TREE;
-    }
+  if (unitlenexp)
+    unitleninit = unitlenexp;
   else
     {
       unitleninit = ffecom_integer_zero_node;
       constantp = FALSE;
     }
-  if (TREE_CONSTANT (unitnumexp))
+
+  /* Now see if we can fully initialize the number of elements, or
+     if we have to compute that at run time.  */
+  if (ffeinfo_rank (ffebld_info (unit_expr)) == 0
+      || (unitexp
+	  && TREE_CODE (TREE_TYPE (TREE_TYPE (unitexp))) != ARRAY_TYPE))
+    {
+      /* Not an array, so just one element.  */
+      unitnuminit = ffecom_integer_one_node;
+      unitnumexp = unitnuminit;
+    }
+  else if (unitexp && unitlenexp)
     {
-      unitnuminit = unitnumexp;
-      unitnumexp = NULL_TREE;
+      /* An array, but all the info is constant, so compute now.  */
+      unitnuminit = size_binop (CEIL_DIV_EXPR,
+				TYPE_SIZE (TREE_TYPE (TREE_TYPE (unitexp))),
+				unitlenexp);
+      unitnuminit = size_binop (CEIL_DIV_EXPR,
+				unitnuminit,
+				size_int (TYPE_PRECISION
+					  (char_type_node)));
+      unitnumexp = unitnuminit;
     }
   else
     {
+      /* Put off computing until run time.  */
       unitnuminit = ffecom_integer_zero_node;
+      unitnumexp = NULL_TREE;
       constantp = FALSE;
     }
 
@@ -1420,11 +1795,11 @@ ffeste_io_icilist_ (bool have_err,
     {
     case FFESTV_formatNONE:
       formatinit = null_pointer_node;
-      formatexp = NULL_TREE;
+      formatexp = formatinit;
       break;
 
     case FFESTV_formatLABEL:
-      formatexp = NULL_TREE;
+      formatexp = error_mark_node;
       formatinit = ffecom_lookup_label (format_spec->u.label);
       if ((formatinit == NULL_TREE)
 	  || (TREE_CODE (formatinit) == ERROR_MARK))
@@ -1436,22 +1811,12 @@ ffeste_io_icilist_ (bool have_err,
       break;
 
     case FFESTV_formatCHAREXPR:
-      formatexp = ffecom_arg_ptr_to_expr (format_spec->u.expr, NULL);
-      if (TREE_CONSTANT (formatexp))
-	{
-	  formatinit = formatexp;
-	  formatexp = NULL_TREE;
-	}
-      else
-	{
-	  formatinit = null_pointer_node;
-	  constantp = FALSE;
-	}
+      ffeste_f2c_init_format_ (formatexp, formatinit, format_spec);
       break;
 
     case FFESTV_formatASTERISK:
       formatinit = null_pointer_node;
-      formatexp = NULL_TREE;
+      formatexp = formatinit;
       break;
 
     case FFESTV_formatINTEXPR:
@@ -1465,21 +1830,21 @@ ffeste_io_icilist_ (bool have_err,
 
     default:
       assert ("bad format spec" == NULL);
-      formatexp = NULL_TREE;
       formatinit = ffecom_integer_zero_node;
+      formatexp = formatinit;
       break;
     }
 
-  ffeste_f2c_flagspec_ (have_end, endinit);
+  ffeste_f2c_init_flag_ (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);
+  ffeste_f2c_init_next_ (unitinit);
+  ffeste_f2c_init_next_ (endinit);
+  ffeste_f2c_init_next_ (formatinit);
+  ffeste_f2c_init_next_ (unitleninit);
+  ffeste_f2c_init_next_ (unitnuminit);
 
   inits = build (CONSTRUCTOR, f2c_icilist_struct, NULL_TREE, inits);
   TREE_CONSTANT (inits) = constantp ? 1 : 0;
@@ -1497,106 +1862,71 @@ ffeste_io_icilist_ (bool have_err,
 
   resume_momentary (yes);
 
-  ffeste_f2c_exp_ (unitfield, unitexp);
-  ffeste_f2c_exp_ (formatfield, formatexp);
-  ffeste_f2c_exp_ (unitlenfield, unitlenexp);
-  ffeste_f2c_exp_ (unitnumfield, unitnumexp);
+  /* Prepare run-time expressions.  */
 
-  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
+  if (! unitexp)
+    ffecom_prepare_arg_ptr_to_expr (unit_expr);
 
-   ffebld expr;
-   ffeste_io_impdo_(expr);
+  ffeste_f2c_prepare_format_ (format_spec, formatexp);
 
-   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.  */
+  ffecom_prepare_end ();
 
-#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;
+  /* Now evaluate run-time expressions as needed.  */
 
-  if (incr == NULL)
+  if (! unitexp || ! unitlenexp)
     {
-      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));
+      int need_unitexp = (! unitexp);
+      int need_unitlenexp = (! unitlenexp);
+ 
+      unitexp = ffecom_arg_ptr_to_expr (unit_expr, &unitlenexp);
+      if (need_unitexp)
+	ffeste_f2c_compile_ (unitfield, unitexp);
+      if (need_unitlenexp)
+	ffeste_f2c_compile_ (unitlenfield, unitlenexp);
     }
 
-  /* 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))
+  if (! unitnumexp
+      && unitexp != error_mark_node
+      && unitlenexp != error_mark_node)
     {
-      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 ();
+      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)));
+      ffeste_f2c_compile_ (unitnumfield, unitnumexp);
     }
 
-  /* Generate end of implied-do construct. */
+  if (format == FFESTV_formatINTEXPR)
+    ffeste_f2c_compile_ (formatfield, formatexp);
+  else
+    ffeste_f2c_compile_format_ (formatfield, format_spec, formatexp);
 
-  ffeste_end_iterdo_ (tvar, tincr, titervar);
-}
+  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_inlist_ -- Make arglist with ptr to INQUIRE control list
 
-   tree arglist;
-   arglist = ffeste_io_inlist_(...);
+/* Make arglist with ptr to INQUIRE control list
 
    Returns a tree suitable as an argument list containing a pointer to
    an INQUIRE-statement control list.  First, generates that control
    list, if necessary, along with any static and run-time initializations
-   that are needed as specified by the arguments to this function.  */
+   that are needed as specified by the arguments to this function.
+
+   Must ensure that all expressions are prepared before being evaluated,
+   for any whose evaluation might result in the generation of temporaries.
+
+   Note that this means this function causes a transition, within the
+   current block being code-generated via the back end, from the
+   declaration of variables (temporaries) to the expanding of expressions,
+   statements, etc.  */
 
 #if FFECOM_targetCURRENT == FFECOM_targetGCC
 static tree
@@ -1717,58 +2047,64 @@ ffeste_io_inlist_ (bool have_err,
       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);
+  /* Try to do as much compile-time initialization of the structure
+     as possible, to save run time.  */
+
+  ffeste_f2c_init_flag_ (have_err, errinit);
+  ffeste_f2c_init_int_ (unitexp, unitinit, unit_spec);
+  ffeste_f2c_init_char_ (fileexp, fileinit, filelenexp, fileleninit,
+			 file_spec);
+  ffeste_f2c_init_ptrtoint_ (existexp, existinit, exist_spec);
+  ffeste_f2c_init_ptrtoint_ (openexp, openinit, open_spec);
+  ffeste_f2c_init_ptrtoint_ (numberexp, numberinit, number_spec);
+  ffeste_f2c_init_ptrtoint_ (namedexp, namedinit, named_spec);
+  ffeste_f2c_init_char_ (nameexp, nameinit, namelenexp, nameleninit,
+			 name_spec);
+  ffeste_f2c_init_char_ (accessexp, accessinit, accesslenexp,
+			 accessleninit, access_spec);
+  ffeste_f2c_init_char_ (sequentialexp, sequentialinit, sequentiallenexp,
+			 sequentialleninit, sequential_spec);
+  ffeste_f2c_init_char_ (directexp, directinit, directlenexp,
+			 directleninit, direct_spec);
+  ffeste_f2c_init_char_ (formexp, forminit, formlenexp, formleninit,
+			 form_spec);
+  ffeste_f2c_init_char_ (formattedexp, formattedinit,
+			 formattedlenexp, formattedleninit, formatted_spec);
+  ffeste_f2c_init_char_ (unformattedexp, unformattedinit, unformattedlenexp,
+			 unformattedleninit, unformatted_spec);
+  ffeste_f2c_init_ptrtoint_ (reclexp, reclinit, recl_spec);
+  ffeste_f2c_init_ptrtoint_ (nextrecexp, nextrecinit, nextrec_spec);
+  ffeste_f2c_init_char_ (blankexp, blankinit, blanklenexp,
+			 blankleninit, blank_spec);
 
   inits = build_tree_list ((field = TYPE_FIELDS (f2c_inquire_struct)),
 			   errinit);
   initn = inits;
-  ffeste_f2c_init_ (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);
+  ffeste_f2c_init_next_ (unitinit);
+  ffeste_f2c_init_next_ (fileinit);
+  ffeste_f2c_init_next_ (fileleninit);
+  ffeste_f2c_init_next_ (existinit);
+  ffeste_f2c_init_next_ (openinit);
+  ffeste_f2c_init_next_ (numberinit);
+  ffeste_f2c_init_next_ (namedinit);
+  ffeste_f2c_init_next_ (nameinit);
+  ffeste_f2c_init_next_ (nameleninit);
+  ffeste_f2c_init_next_ (accessinit);
+  ffeste_f2c_init_next_ (accessleninit);
+  ffeste_f2c_init_next_ (sequentialinit);
+  ffeste_f2c_init_next_ (sequentialleninit);
+  ffeste_f2c_init_next_ (directinit);
+  ffeste_f2c_init_next_ (directleninit);
+  ffeste_f2c_init_next_ (forminit);
+  ffeste_f2c_init_next_ (formleninit);
+  ffeste_f2c_init_next_ (formattedinit);
+  ffeste_f2c_init_next_ (formattedleninit);
+  ffeste_f2c_init_next_ (unformattedinit);
+  ffeste_f2c_init_next_ (unformattedleninit);
+  ffeste_f2c_init_next_ (reclinit);
+  ffeste_f2c_init_next_ (nextrecinit);
+  ffeste_f2c_init_next_ (blankinit);
+  ffeste_f2c_init_next_ (blankleninit);
 
   inits = build (CONSTRUCTOR, f2c_inquire_struct, NULL_TREE, inits);
   TREE_CONSTANT (inits) = constantp ? 1 : 0;
@@ -1786,31 +2122,56 @@ ffeste_io_inlist_ (bool have_err,
 
   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);
+  /* Prepare run-time expressions.  */
+
+  ffeste_f2c_prepare_int_ (unit_spec, unitexp);
+  ffeste_f2c_prepare_char_ (file_spec, fileexp);
+  ffeste_f2c_prepare_ptrtoint_ (exist_spec, existexp);
+  ffeste_f2c_prepare_ptrtoint_ (open_spec, openexp);
+  ffeste_f2c_prepare_ptrtoint_ (number_spec, numberexp);
+  ffeste_f2c_prepare_ptrtoint_ (named_spec, namedexp);
+  ffeste_f2c_prepare_char_ (name_spec, nameexp);
+  ffeste_f2c_prepare_char_ (access_spec, accessexp);
+  ffeste_f2c_prepare_char_ (sequential_spec, sequentialexp);
+  ffeste_f2c_prepare_char_ (direct_spec, directexp);
+  ffeste_f2c_prepare_char_ (form_spec, formexp);
+  ffeste_f2c_prepare_char_ (formatted_spec, formattedexp);
+  ffeste_f2c_prepare_char_ (unformatted_spec, unformattedexp);
+  ffeste_f2c_prepare_ptrtoint_ (recl_spec, reclexp);
+  ffeste_f2c_prepare_ptrtoint_ (nextrec_spec, nextrecexp);
+  ffeste_f2c_prepare_char_ (blank_spec, blankexp);
+
+  ffecom_prepare_end ();
+
+  /* Now evaluate run-time expressions as needed.  */
+
+  ffeste_f2c_compile_int_ (unitfield, unit_spec, unitexp);
+  ffeste_f2c_compile_char_ (filefield, filelenfield, file_spec,
+			    fileexp, filelenexp);
+  ffeste_f2c_compile_ptrtoint_ (existfield, exist_spec, existexp);
+  ffeste_f2c_compile_ptrtoint_ (openfield, open_spec, openexp);
+  ffeste_f2c_compile_ptrtoint_ (numberfield, number_spec, numberexp);
+  ffeste_f2c_compile_ptrtoint_ (namedfield, named_spec, namedexp);
+  ffeste_f2c_compile_char_ (namefield, namelenfield, name_spec, nameexp,
+			    namelenexp);
+  ffeste_f2c_compile_char_ (accessfield, accesslenfield, access_spec,
+			    accessexp, accesslenexp);
+  ffeste_f2c_compile_char_ (sequentialfield, sequentiallenfield,
+			    sequential_spec, sequentialexp,
+			    sequentiallenexp);
+  ffeste_f2c_compile_char_ (directfield, directlenfield, direct_spec,
+			    directexp, directlenexp);
+  ffeste_f2c_compile_char_ (formfield, formlenfield, form_spec, formexp,
+			    formlenexp);
+  ffeste_f2c_compile_char_ (formattedfield, formattedlenfield, formatted_spec,
+			    formattedexp, formattedlenexp);
+  ffeste_f2c_compile_char_ (unformattedfield, unformattedlenfield,
+			    unformatted_spec, unformattedexp,
+			    unformattedlenexp);
+  ffeste_f2c_compile_ptrtoint_ (reclfield, recl_spec, reclexp);
+  ffeste_f2c_compile_ptrtoint_ (nextrecfield, nextrec_spec, nextrecexp);
+  ffeste_f2c_compile_char_ (blankfield, blanklenfield, blank_spec, blankexp,
+			    blanklenexp);
 
   ttype = build_pointer_type (TREE_TYPE (t));
   t = ffecom_1 (ADDR_EXPR, ttype, t);
@@ -1821,15 +2182,20 @@ ffeste_io_inlist_ (bool have_err,
 }
 
 #endif
-/* ffeste_io_olist_ -- Make arglist with ptr to OPEN control list
-
-   tree arglist;
-   arglist = ffeste_io_olist_(...);
+/* Make arglist with ptr to OPEN control list
 
    Returns a tree suitable as an argument list containing a pointer to
    an OPEN-statement control list.  First, generates that control
    list, if necessary, along with any static and run-time initializations
-   that are needed as specified by the arguments to this function.  */
+   that are needed as specified by the arguments to this function.
+
+   Must ensure that all expressions are prepared before being evaluated,
+   for any whose evaluation might result in the generation of temporaries.
+
+   Note that this means this function causes a transition, within the
+   current block being code-generated via the back end, from the
+   declaration of variables (temporaries) to the expanding of expressions,
+   statements, etc.  */
 
 #if FFECOM_targetCURRENT == FFECOM_targetGCC
 static tree
@@ -1896,37 +2262,38 @@ ffeste_io_olist_ (bool have_err,
       f2c_open_struct = ref;
     }
 
-  ffeste_f2c_flagspec_ (have_err, errinit);
+  /* Try to do as much compile-time initialization of the structure
+     as possible, to save run time.  */
 
-  unitexp = ffecom_expr (unit_expr);
-  if (TREE_CONSTANT (unitexp))
-    {
-      unitinit = unitexp;
-      unitexp = NULL_TREE;
-    }
+  ffeste_f2c_init_flag_ (have_err, errinit);
+
+  unitexp = ffecom_const_expr (unit_expr);
+  if (unitexp)
+    unitinit = unitexp;
   else
     {
       unitinit = ffecom_integer_zero_node;
       constantp = FALSE;
     }
 
-  ffeste_f2c_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);
+  ffeste_f2c_init_char_ (fileexp, fileinit, filelenexp, fileleninit,
+			 file_spec);
+  ffeste_f2c_init_charnolen_ (statexp, statinit, stat_spec);
+  ffeste_f2c_init_charnolen_ (accessexp, accessinit, access_spec);
+  ffeste_f2c_init_charnolen_ (formexp, forminit, form_spec);
+  ffeste_f2c_init_int_ (reclexp, reclinit, recl_spec);
+  ffeste_f2c_init_charnolen_ (blankexp, blankinit, blank_spec);
 
   inits = build_tree_list ((field = TYPE_FIELDS (f2c_open_struct)), errinit);
   initn = inits;
-  ffeste_f2c_init_ (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);
+  ffeste_f2c_init_next_ (unitinit);
+  ffeste_f2c_init_next_ (fileinit);
+  ffeste_f2c_init_next_ (fileleninit);
+  ffeste_f2c_init_next_ (statinit);
+  ffeste_f2c_init_next_ (accessinit);
+  ffeste_f2c_init_next_ (forminit);
+  ffeste_f2c_init_next_ (reclinit);
+  ffeste_f2c_init_next_ (blankinit);
 
   inits = build (CONSTRUCTOR, f2c_open_struct, NULL_TREE, inits);
   TREE_CONSTANT (inits) = constantp ? 1 : 0;
@@ -1944,14 +2311,35 @@ ffeste_io_olist_ (bool have_err,
 
   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);
+  /* Prepare run-time expressions.  */
+
+  if (! unitexp)
+    ffecom_prepare_expr (unit_expr);
+
+  ffeste_f2c_prepare_char_ (file_spec, fileexp);
+  ffeste_f2c_prepare_charnolen_ (stat_spec, statexp);
+  ffeste_f2c_prepare_charnolen_ (access_spec, accessexp);
+  ffeste_f2c_prepare_charnolen_ (form_spec, formexp);
+  ffeste_f2c_prepare_int_ (recl_spec, reclexp);
+  ffeste_f2c_prepare_charnolen_ (blank_spec, blankexp);
+
+  ffecom_prepare_end ();
+
+  /* Now evaluate run-time expressions as needed.  */
+
+  if (! unitexp)
+    {
+      unitexp = ffecom_expr (unit_expr);
+      ffeste_f2c_compile_ (unitfield, unitexp);
+    }
+
+  ffeste_f2c_compile_char_ (filefield, filelenfield, file_spec, fileexp,
+			    filelenexp);
+  ffeste_f2c_compile_charnolen_ (statfield, stat_spec, statexp);
+  ffeste_f2c_compile_charnolen_ (accessfield, access_spec, accessexp);
+  ffeste_f2c_compile_charnolen_ (formfield, form_spec, formexp);
+  ffeste_f2c_compile_int_ (reclfield, recl_spec, reclexp);
+  ffeste_f2c_compile_charnolen_ (blankfield, blank_spec, blankexp);
 
   ttype = build_pointer_type (TREE_TYPE (t));
   t = ffecom_1 (ADDR_EXPR, ttype, t);
@@ -1962,9 +2350,7 @@ ffeste_io_olist_ (bool have_err,
 }
 
 #endif
-/* ffeste_subr_file_ -- Display file-statement specifier
-
-   ffeste_subr_file_(&specifier);  */
+/* Display file-statement specifier.  */
 
 #if FFECOM_targetCURRENT == FFECOM_targetFFE
 static void
@@ -1989,9 +2375,7 @@ ffeste_subr_file_ (const char *kw, ffestpFile *spec)
 }
 #endif
 
-/* ffeste_subr_beru_ -- Generate code for BACKSPACE/ENDFILE/REWIND
-
-   ffeste_subr_beru_(FFECOM_gfrtFBACK);	 */
+/* Generate code for BACKSPACE/ENDFILE/REWIND.  */
 
 #if FFECOM_targetCURRENT == FFECOM_targetGCC
 static void
@@ -2001,15 +2385,15 @@ ffeste_subr_beru_ (ffestpBeruStmt *info, ffecomGfrt rt)
   bool iostat;
   bool errl;
 
-#define specified(something) (info->beru_spec[something].kw_or_val_present)
-
   ffeste_emit_line_note_ ();
 
-  /* Do the real work. */
+#define specified(something) (info->beru_spec[something].kw_or_val_present)
 
   iostat = specified (FFESTP_beruixIOSTAT);
   errl = specified (FFESTP_beruixERR);
 
+#undef specified
+
   /* ~~For now, we assume the unit number is specified and is not ASTERISK,
      because the FFE doesn't support BACKSPACE(*) and rejects a BACKSPACE
      without any unit specifier.  f2c, however, supports the former
@@ -2018,15 +2402,14 @@ ffeste_subr_beru_ (ffestpBeruStmt *info, ffecomGfrt rt)
      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. */
+     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);
+  ffeste_start_stmt_ ();
 
   if (errl)
-    {				/* ERR= */
+    {
+      /* Have ERR= specification.   */
+
       ffeste_io_err_
 	= ffeste_io_abort_
 	= ffecom_lookup_label
@@ -2034,7 +2417,9 @@ ffeste_subr_beru_ (ffestpBeruStmt *info, ffecomGfrt rt)
       ffeste_io_abort_is_temp_ = FALSE;
     }
   else
-    {				/* no ERR= */
+    {
+      /* No ERR= specification.  */
+
       ffeste_io_err_ = NULL_TREE;
 
       if ((ffeste_io_abort_is_temp_ = iostat))
@@ -2044,29 +2429,40 @@ ffeste_subr_beru_ (ffestpBeruStmt *info, ffecomGfrt rt)
     }
 
   if (iostat)
-    {				/* IOSTAT= */
+    {
+      /* Have IOSTAT= specification.  */
+
       ffeste_io_iostat_is_temp_ = FALSE;
       ffeste_io_iostat_ = ffecom_expr
 	(info->beru_spec[FFESTP_beruixIOSTAT].u.expr);
     }
   else if (ffeste_io_abort_ != NULL_TREE)
-    {				/* no IOSTAT= but ERR= */
+    {
+      /* Have no IOSTAT= but have ERR=.  */
+
       ffeste_io_iostat_is_temp_ = TRUE;
       ffeste_io_iostat_
-	= ffecom_push_tempvar (ffecom_integer_type_node,
-			       FFETARGET_charactersizeNONE, -1, FALSE);
+	= ffecom_make_tempvar ("beru", ffecom_integer_type_node,
+			       FFETARGET_charactersizeNONE, -1);
     }
   else
-    {				/* no IOSTAT=, or ERR= */
+    {
+      /* No IOSTAT= or ERR= specification.  */
+
       ffeste_io_iostat_is_temp_ = FALSE;
       ffeste_io_iostat_ = NULL_TREE;
     }
 
+  /* Now prescan, then convert, all the arguments.  */
+
+  alist = ffeste_io_ialist_ (errl || iostat, FFESTV_unitINTEXPR,
+			     info->beru_spec[FFESTP_beruixUNIT].u.expr, 6);
+
   /* Don't generate "if (iostat != 0) goto label;" if label is temp abort
      label, since we're gonna fall through to there anyway. */
 
-  ffeste_io_call_ (ffecom_call_gfrt (rt, alist),
-		   !ffeste_io_abort_is_temp_);
+  ffeste_io_call_ (ffecom_call_gfrt (rt, alist, NULL_TREE),
+		   ! ffeste_io_abort_is_temp_);
 
   /* If we've got a temp label, generate its code here. */
 
@@ -2079,28 +2475,16 @@ ffeste_subr_beru_ (ffestpBeruStmt *info, ffecomGfrt rt)
       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 ();
+  ffeste_end_stmt_ ();
 }
-
 #endif
-/* ffeste_do -- End of statement following DO-term-stmt etc
 
-   ffeste_do(TRUE);
+/* END DO statement
 
    Also invoked by _labeldef_branch_finish_ (or, in cases
    of errors, other _labeldef_ functions) when the label definition is
    for a DO-target (LOOPEND) label, once per matching/outstanding DO
-   block on the stack.	These cases invoke this function with ok==TRUE, so
-   only forced stack popping (via ffeste_eof_()) invokes it with ok==FALSE.  */
+   block on the stack.  */
 
 void
 ffeste_do (ffestw block)
@@ -2109,28 +2493,26 @@ ffeste_do (ffestw block)
   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. */
+    {
+      expand_end_loop ();		/* DO WHILE and just DO. */
+
+      ffeste_end_block_ (block);
+    }
   else
-    ffeste_end_iterdo_ (ffestw_do_tvar (block),
+    ffeste_end_iterdo_ (block,
+			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);
+/* End of statement following logical IF.
 
-   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_().	*/
+   Applies to *only* logical IF, not to IF-THEN.  */
 
 void
 ffeste_end_R807 ()
@@ -2139,16 +2521,16 @@ ffeste_end_R807 ()
   fputs ("+ END_IF\n", dmpout);	/* Also see ffeste_R806. */
 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
   ffeste_emit_line_note_ ();
+
   expand_end_cond ();
-  clear_momentary ();
+
+  ffeste_end_block_ (NULL);
 #else
 #error
 #endif
 }
 
-/* ffeste_labeldef_branch -- Generate "code" for branch label def
-
-   ffeste_labeldef_branch(label);  */
+/* Generate "code" for branch label definition.  */
 
 void
 ffeste_labeldef_branch (ffelab label)
@@ -2163,11 +2545,15 @@ ffeste_labeldef_branch (ffelab 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
@@ -2175,9 +2561,7 @@ ffeste_labeldef_branch (ffelab label)
 #endif
 }
 
-/* ffeste_labeldef_format -- Generate "code" for FORMAT label def
-
-   ffeste_labeldef_format(label);  */
+/* Generate "code" for FORMAT label definition.  */
 
 void
 ffeste_labeldef_format (ffelab label)
@@ -2191,9 +2575,7 @@ ffeste_labeldef_format (ffelab label)
 #endif
 }
 
-/* ffeste_R737A -- Assignment statement outside of WHERE
-
-   ffeste_R737A(dest_expr,source_expr);	 */
+/* Assignment statement (outside of WHERE).  */
 
 void
 ffeste_R737A (ffebld dest, ffebld source)
@@ -2208,25 +2590,21 @@ ffeste_R737A (ffebld dest, ffebld source)
   fputc ('\n', dmpout);
 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
   ffeste_emit_line_note_ ();
-  ffecom_push_calltemps ();
+
+  ffeste_start_stmt_ ();
 
   ffecom_expand_let_stmt (dest, source);
 
-  ffecom_pop_calltemps ();
-  clear_momentary ();
+  ffeste_end_stmt_ ();
 #else
 #error
 #endif
 }
 
-/* ffeste_R803 -- Block IF (IF-THEN) statement
-
-   ffeste_R803(construct_name,expr,expr_token);
-
-   Make sure statement is valid here; implement.  */
+/* Block IF (IF-THEN) statement.  */
 
 void
-ffeste_R803 (ffebld expr)
+ffeste_R803 (ffestw block, ffebld expr)
 {
   ffeste_check_simple_ ();
 
@@ -2235,28 +2613,53 @@ ffeste_R803 (ffebld expr)
   ffebld_dump (expr);
   fputs (")\n", dmpout);
 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
-  ffeste_emit_line_note_ ();
-  ffecom_push_calltemps ();
+  {
+    tree temp;
 
-  expand_start_cond (ffecom_truth_value (ffecom_expr (expr)), 0);
+    ffeste_emit_line_note_ ();
 
-  ffecom_pop_calltemps ();
-  clear_momentary ();
+    ffeste_start_block_ (block);
+
+    temp = ffecom_make_tempvar ("ifthen", integer_type_node,
+				FFETARGET_charactersizeNONE, -1);
+
+    ffeste_start_stmt_ ();
+
+    ffecom_prepare_expr (expr);
+
+    if (ffecom_prepare_end ())
+      {
+	tree result;
+
+	result = ffecom_modify (void_type_node,
+				temp,
+				ffecom_truth_value (ffecom_expr (expr)));
+
+	expand_expr_stmt (result);
+
+	ffeste_end_stmt_ ();
+      }
+    else
+      {
+	ffeste_end_stmt_ ();
+
+	temp = ffecom_truth_value (ffecom_expr (expr));
+      }
+
+    expand_start_cond (temp, 0);
+
+    /* No fake `else' constructs introduced (yet).  */
+    ffestw_set_ifthen_fake_else (block, 0);
+  }
 #else
 #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.  */
+/* ELSE IF statement.  */
 
 void
-ffeste_R804 (ffebld expr)
+ffeste_R804 (ffestw block, ffebld expr)
 {
   ffeste_check_simple_ ();
 
@@ -2265,28 +2668,65 @@ ffeste_R804 (ffebld expr)
   ffebld_dump (expr);
   fputs (")\n", dmpout);
 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
-  ffeste_emit_line_note_ ();
-  ffecom_push_calltemps ();
+  {
+    tree temp;
+
+    ffeste_emit_line_note_ ();
 
-  expand_start_elseif (ffecom_truth_value (ffecom_expr (expr)));
+    /* Since ELSEIF(expr) might require preparations for expr,
+       implement as ELSE; prepare-expr; IF (expr) THEN ...; ENDIF.  */
 
-  ffecom_pop_calltemps ();
-  clear_momentary ();
+    expand_start_else ();
+
+    ffeste_start_block_ (block);
+
+    temp = ffecom_make_tempvar ("elseif", integer_type_node,
+				FFETARGET_charactersizeNONE, -1);
+
+    ffeste_start_stmt_ ();
+
+    ffecom_prepare_expr (expr);
+
+    if (ffecom_prepare_end ())
+      {
+	tree result;
+
+	result = ffecom_modify (void_type_node,
+				temp,
+				ffecom_truth_value (ffecom_expr (expr)));
+
+	expand_expr_stmt (result);
+
+	ffeste_end_stmt_ ();
+      }
+    else
+      {
+	/* In this case, we could probably have used expand_start_elseif
+	   instead, saving the need for a fake `else' construct.  But,
+	   until it's clear that'd improve performance, it's easier this
+	   way, since we have to expand_start_else before we get to this
+	   test, given the current design.  */
+
+	ffeste_end_stmt_ ();
+
+	temp = ffecom_truth_value (ffecom_expr (expr));
+      }
+
+    expand_start_cond (temp, 0);
+
+    /* Increment number of fake `else' constructs introduced.  */
+    ffestw_set_ifthen_fake_else (block,
+				 ffestw_ifthen_fake_else (block) + 1);
+  }
 #else
 #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.  */
+/* ELSE statement.  */
 
 void
-ffeste_R805 ()
+ffeste_R805 (ffestw block UNUSED)
 {
   ffeste_check_simple_ ();
 
@@ -2294,36 +2734,39 @@ ffeste_R805 ()
   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);  */
+/* END IF statement.  */
 
 void
-ffeste_R806 ()
+ffeste_R806 (ffestw block)
 {
 #if FFECOM_targetCURRENT == FFECOM_targetFFE
   fputs ("+ END_IF_then\n", dmpout);	/* Also see ffeste_shriek_if_. */
 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
-  ffeste_emit_line_note_ ();
-  expand_end_cond ();
-  clear_momentary ();
+  {
+    int i = ffestw_ifthen_fake_else (block) + 1;
+
+    ffeste_emit_line_note_ ();
+
+    for (; i; --i)
+      {
+	expand_end_cond ();
+
+	ffeste_end_block_ (block);
+      }
+  }
 #else
 #error
 #endif
 }
 
-/* ffeste_R807 -- Logical IF statement
-
-   ffeste_R807(expr,expr_token);
-
-   Make sure statement is valid here; implement.  */
+/* Logical IF statement.  */
 
 void
 ffeste_R807 (ffebld expr)
@@ -2335,23 +2778,47 @@ ffeste_R807 (ffebld expr)
   ffebld_dump (expr);
   fputs (")\n", dmpout);
 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
-  ffeste_emit_line_note_ ();
-  ffecom_push_calltemps ();
+  {
+    tree temp;
 
-  expand_start_cond (ffecom_truth_value (ffecom_expr (expr)), 0);
+    ffeste_emit_line_note_ ();
 
-  ffecom_pop_calltemps ();
-  clear_momentary ();
+    ffeste_start_block_ (NULL);
+
+    temp = ffecom_make_tempvar ("if", integer_type_node,
+				FFETARGET_charactersizeNONE, -1);
+
+    ffeste_start_stmt_ ();
+
+    ffecom_prepare_expr (expr);
+
+    if (ffecom_prepare_end ())
+      {
+	tree result;
+
+	result = ffecom_modify (void_type_node,
+				temp,
+				ffecom_truth_value (ffecom_expr (expr)));
+
+	expand_expr_stmt (result);
+
+	ffeste_end_stmt_ ();
+      }
+    else
+      {
+	ffeste_end_stmt_ ();
+
+	temp = ffecom_truth_value (ffecom_expr (expr));
+      }
+
+    expand_start_cond (temp, 0);
+  }
 #else
 #error
 #endif
 }
 
-/* ffeste_R809 -- SELECT CASE statement
-
-   ffeste_R809(construct_name,expr,expr_token);
-
-   Make sure statement is valid here; implement.  */
+/* SELECT CASE statement.  */
 
 void
 ffeste_R809 (ffestw block, ffebld expr)
@@ -2363,52 +2830,63 @@ ffeste_R809 (ffestw block, ffebld expr)
   ffebld_dump (expr);
   fputs (")\n", dmpout);
 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
-  ffecom_push_calltemps ();
+  ffeste_emit_line_note_ ();
 
-  {
-    tree texpr;
+  ffeste_start_block_ (block);
 
-    ffeste_emit_line_note_ ();
+  if ((expr == NULL)
+      || (ffeinfo_basictype (ffebld_info (expr))
+	  == FFEINFO_basictypeANY))
+    ffestw_set_select_texpr (block, error_mark_node);
+  else if (ffeinfo_basictype (ffebld_info (expr))
+	   == FFEINFO_basictypeCHARACTER)
+    {
+      /* ~~~Someday handle CHARACTER*1, CHARACTER*N */
 
-    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);
-	  }
-      }
-  }
+      ffebad_start_msg ("SELECT CASE on CHARACTER type (at %0) not supported -- sorry",
+			FFEBAD_severityFATAL);
+      ffebad_here (0, ffestw_line (block), ffestw_col (block));
+      ffebad_finish ();
+      ffestw_set_select_texpr (block, error_mark_node);
+    }
+  else
+    {
+      tree result;
+      tree texpr;
+
+      result = ffecom_make_tempvar ("select", ffecom_type_expr (expr),
+				    ffeinfo_size (ffebld_info (expr)),
+				    -1);
+
+      ffeste_start_stmt_ ();
+
+      ffecom_prepare_expr (expr);
+
+      ffecom_prepare_end ();
+
+      texpr = ffecom_expr (expr);
+
+      assert (TYPE_MAIN_VARIANT (TREE_TYPE (texpr))
+	      == TYPE_MAIN_VARIANT (TREE_TYPE (result)));
+
+      texpr = ffecom_modify (void_type_node,
+			     result,
+			     texpr);
+      expand_expr_stmt (texpr);
+
+      ffeste_end_stmt_ ();
 
-  ffecom_pop_calltemps ();
+      expand_start_case (1, result, TREE_TYPE (result),
+			 "SELECT CASE statement");
+      ffestw_set_select_texpr (block, texpr);
+      ffestw_set_select_break (block, FALSE);
+    }
 #else
 #error
 #endif
 }
 
-/* ffeste_R810 -- CASE statement
-
-   ffeste_R810(case_value_range_list,name);
+/* CASE statement.
 
    If casenum is 0, it's CASE DEFAULT.	Else it's the case ranges at
    the start of the first_stmt list in the select object at the top of
@@ -2466,17 +2944,18 @@ ffeste_R810 (ffestw block, unsigned long casenum)
   {
     tree texprlow;
     tree texprhigh;
-    tree tlabel = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE);
+    tree tlabel;
     int pushok;
     tree duplicate;
 
     ffeste_emit_line_note_ ();
 
-    if (TREE_CODE (ffestw_select_texpr (block)) == ERROR_MARK)
-      {
-	clear_momentary ();
-	return;
-      }
+    if (ffestw_select_texpr (block) == error_mark_node)
+      return;
+
+    /* ~~~Someday handle CHARACTER*1, CHARACTER*N */
+
+    tlabel = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE);
 
     if (ffestw_select_break (block))
       expand_exit_something ();
@@ -2516,15 +2995,13 @@ ffeste_R810 (ffestw block, unsigned long casenum)
       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);  */
+/* END SELECT statement.  */
 
 void
 ffeste_R811 (ffestw block)
@@ -2534,15 +3011,12 @@ ffeste_R811 (ffestw block)
 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
   ffeste_emit_line_note_ ();
 
-  if (TREE_CODE (ffestw_select_texpr (block)) == ERROR_MARK)
-    {
-      clear_momentary ();
-      return;
-    }
+  /* ~~~Someday handle CHARACTER*1, CHARACTER*N */
+
+  if (TREE_CODE (ffestw_select_texpr (block)) != ERROR_MARK)
+    expand_end_case (ffestw_select_texpr (block));
 
-  expand_end_case (ffestw_select_texpr (block));
-  pop_momentary ();
-  clear_momentary ();		/* ~~~handle character and character*1 */
+  ffeste_end_block_ (block);
 #else
 #error
 #endif
@@ -2585,9 +3059,6 @@ ffeste_R819A (ffestw block, ffelab label UNUSED, ffebld var,
 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
   {
     ffeste_emit_line_note_ ();
-    ffecom_push_calltemps ();
-
-    /* Start the DO loop.  */
 
     ffeste_begin_iterdo_ (block, NULL, NULL, NULL,
 			  var,
@@ -2595,19 +3066,13 @@ ffeste_R819A (ffestw block, ffelab label UNUSED, ffebld var,
 			  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.  */
+/* DO WHILE statement.  */
 
 void
 ffeste_R819B (ffestw block, ffelab label UNUSED, ffebld expr)
@@ -2623,32 +3088,50 @@ ffeste_R819B (ffestw block, ffelab label UNUSED, ffebld expr)
   fputs (")\n", dmpout);
 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
   {
+    tree result;
+
     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)));
+    ffeste_start_block_ (block);
 
-    ffecom_pop_calltemps ();
-    clear_momentary ();
+    if (expr)
+      {
+	result = ffecom_make_tempvar ("dowhile", integer_type_node,
+				      FFETARGET_charactersizeNONE, -1);
+
+	ffeste_start_stmt_ ();
+
+	ffecom_prepare_expr (expr);
+
+	ffecom_prepare_end ();
+
+	result = ffecom_modify (void_type_node,
+				result,
+				ffecom_truth_value (ffecom_expr (expr)));
+	expand_expr_stmt (result);
+
+	ffeste_end_stmt_ ();
+
+	ffestw_set_do_hook (block, expand_start_loop (1));
+	expand_exit_loop_if_false (0, result);
+      }
+    else
+      ffestw_set_do_hook (block, expand_start_loop (1));
+
+    ffestw_set_do_tvar (block, NULL_TREE);
   }
 #else
 #error
 #endif
 }
 
-/* ffeste_R825 -- END DO statement
-
-   ffeste_R825(name_token);
+/* END DO statement.
 
-   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.	 */
+   This is the MIL-STD 1753 END DO. It's syntactic sugar, similar to
+   CONTINUE (except that it has to have a label that is the target of
+   one or more iterative DO statement), not the Fortran-90 structured
+   END DO, which is handled elsewhere, as is the actual mechanism of
+   ending an iterative DO statement, even one that ends at a label.  */
 
 void
 ffeste_R825 ()
@@ -2659,17 +3142,14 @@ ffeste_R825 ()
   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.  */
+/* CYCLE statement.  */
 
 void
 ffeste_R834 (ffestw block)
@@ -2680,18 +3160,14 @@ ffeste_R834 (ffestw block)
   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.	 */
+/* EXIT statement.  */
 
 void
 ffeste_R835 (ffestw block)
@@ -2702,19 +3178,14 @@ ffeste_R835 (ffestw block)
   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.  */
+/* GOTO statement.  */
 
 void
 ffeste_R836 (ffelab label)
@@ -2728,13 +3199,13 @@ ffeste_R836 (ffelab label)
     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 ();
+	TREE_USED (glabel) = 1;
       }
   }
 #else
@@ -2742,12 +3213,7 @@ ffeste_R836 (ffelab label)
 #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.  */
+/* Computed GOTO statement.  */
 
 void
 ffeste_R837 (ffelab *labels, int count, ffebld expr)
@@ -2776,12 +3242,17 @@ ffeste_R837 (ffelab *labels, int count, ffebld expr)
     tree duplicate;
 
     ffeste_emit_line_note_ ();
-    ffecom_push_calltemps ();
+
+    ffeste_start_stmt_ ();
+
+    ffecom_prepare_expr (expr);
+
+    ffecom_prepare_end ();
 
     texpr = ffecom_expr (expr);
+
     expand_start_case (0, texpr, TREE_TYPE (texpr), "computed GOTO statement");
-    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);
@@ -2789,33 +3260,25 @@ ffeste_R837 (ffelab *labels, int count, ffebld expr)
 
 	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 ();
+	TREE_USED (tlabel) = 1;
       }
-    pop_momentary ();
     expand_end_case (texpr);
 
-    ffecom_pop_calltemps ();
-    clear_momentary ();
+    ffeste_end_stmt_ ();
   }
 #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.  */
+/* ASSIGN statement.  */
 
 void
 ffeste_R838 (ffelab label, ffebld target)
@@ -2833,7 +3296,9 @@ ffeste_R838 (ffelab label, ffebld target)
     tree target_tree;
 
     ffeste_emit_line_note_ ();
-    ffecom_push_calltemps ();
+
+    /* No need to call ffeste_start_stmt_(), as the sorts of expressions
+       seen here should never require use of temporaries.  */
 
     label_tree = ffecom_lookup_label (label);
     if ((label_tree != NULL_TREE)
@@ -2843,31 +3308,28 @@ ffeste_R838 (ffelab label, ffebld target)
 			       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.  */
+/* Assigned GOTO statement.  */
 
 void
 ffeste_R839 (ffebld target)
@@ -2883,15 +3345,17 @@ ffeste_R839 (ffebld target)
     tree t;
 
     ffeste_emit_line_note_ ();
-    ffecom_push_calltemps ();
+
+    /* No need to call ffeste_start_stmt_(), as the sorts of expressions
+       seen here should never require use of temporaries.  */
 
     t = ffecom_expr_assign (target);
     if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (t)))
 	< GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (null_pointer_node))))
       error ("ASSIGNed GOTO target variable is too small");
+
     expand_computed_goto (convert (TREE_TYPE (null_pointer_node), t));
 
-    ffecom_pop_calltemps ();
     clear_momentary ();
   }
 #else
@@ -2899,11 +3363,7 @@ ffeste_R839 (ffebld target)
 #endif
 }
 
-/* ffeste_R840 -- Arithmetic IF statement
-
-   ffeste_R840(expr,expr_token,neg,zero,pos);
-
-   Make sure the labels are valid; implement.  */
+/* Arithmetic IF statement.  */
 
 void
 ffeste_R840 (ffebld expr, ffelab neg, ffelab zero, ffelab pos)
@@ -2922,6 +3382,8 @@ ffeste_R840 (ffebld expr, ffelab neg, ffelab zero, ffelab pos)
     tree gpos = ffecom_lookup_label (pos);
     tree texpr;
 
+    ffeste_emit_line_note_ ();
+
     if ((gneg == NULL_TREE) || (gzero == NULL_TREE) || (gpos == NULL_TREE))
       return;
     if ((TREE_CODE (gneg) == ERROR_MARK)
@@ -2929,15 +3391,19 @@ ffeste_R840 (ffebld expr, ffelab neg, ffelab zero, ffelab pos)
 	|| (TREE_CODE (gpos) == ERROR_MARK))
       return;
 
-    ffecom_push_calltemps ();
+    ffeste_start_stmt_ ();
+
+    ffecom_prepare_expr (expr);
+
+    ffecom_prepare_end ();
 
     if (neg == zero)
       {
 	if (neg == pos)
 	  expand_goto (gzero);
 	else
-	  {			/* IF (expr.LE.0) THEN GOTO neg/zero ELSE
-				   GOTO pos. */
+	  {
+	    /* IF (expr.LE.0) THEN GOTO neg/zero ELSE GOTO pos.  */
 	    texpr = ffecom_expr (expr);
 	    texpr = ffecom_2 (LE_EXPR, integer_type_node,
 			      texpr,
@@ -2951,8 +3417,8 @@ ffeste_R840 (ffebld expr, ffelab neg, ffelab zero, ffelab pos)
 	  }
       }
     else if (neg == pos)
-      {				/* IF (expr.NE.0) THEN GOTO neg/pos ELSE GOTO
-				   zero. */
+      {
+	/* IF (expr.NE.0) THEN GOTO neg/pos ELSE GOTO zero.  */
 	texpr = ffecom_expr (expr);
 	texpr = ffecom_2 (NE_EXPR, integer_type_node,
 			  texpr,
@@ -2965,8 +3431,8 @@ ffeste_R840 (ffebld expr, ffelab neg, ffelab zero, ffelab pos)
 	expand_end_cond ();
       }
     else if (zero == pos)
-      {				/* IF (expr.GE.0) THEN GOTO zero/pos ELSE
-				   GOTO neg. */
+      {
+	/* IF (expr.GE.0) THEN GOTO zero/pos ELSE GOTO neg.  */
 	texpr = ffecom_expr (expr);
 	texpr = ffecom_2 (GE_EXPR, integer_type_node,
 			  texpr,
@@ -2979,10 +3445,11 @@ ffeste_R840 (ffebld expr, ffelab neg, ffelab zero, ffelab pos)
 	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. */
+      {
+	/* 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,
@@ -3001,19 +3468,15 @@ ffeste_R840 (ffebld expr, ffelab neg, ffelab zero, ffelab pos)
 	expand_goto (gzero);
 	expand_end_cond ();
       }
-    ffeste_emit_line_note_ ();
 
-    ffecom_pop_calltemps ();
-    clear_momentary ();
+    ffeste_end_stmt_ ();
   }
 #else
 #error
 #endif
 }
 
-/* ffeste_R841 -- CONTINUE statement
-
-   ffeste_R841();  */
+/* CONTINUE statement.  */
 
 void
 ffeste_R841 ()
@@ -3024,15 +3487,14 @@ ffeste_R841 ()
   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);  */
+/* STOP statement.  */
 
 void
 ffeste_R842 (ffebld expr)
@@ -3056,6 +3518,7 @@ ffeste_R842 (ffebld expr)
     ffelexToken msg;
 
     ffeste_emit_line_note_ ();
+
     if ((expr == NULL)
 	|| (ffeinfo_basictype (ffebld_info (expr))
 	    == FFEINFO_basictypeANY))
@@ -3099,12 +3562,16 @@ ffeste_R842 (ffebld expr)
 		== FFEINFO_kindtypeCHARACTERDEFAULT);
       }
 
-    ffecom_push_calltemps ();
+    /* No need to call ffeste_start_stmt_(), as the sorts of expressions
+       seen here should never require use of temporaries.  */
+
     callit = ffecom_call_gfrt (FFECOM_gfrtSTOP,
-		    ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)));
-    ffecom_pop_calltemps ();
+		    ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)),
+			       NULL_TREE);
     TREE_SIDE_EFFECTS (callit) = 1;
+
     expand_expr_stmt (callit);
+
     clear_momentary ();
   }
 #else
@@ -3112,12 +3579,7 @@ ffeste_R842 (ffebld expr)
 #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.  */
+/* PAUSE statement.  */
 
 void
 ffeste_R843 (ffebld expr)
@@ -3141,6 +3603,7 @@ ffeste_R843 (ffebld expr)
     ffelexToken msg;
 
     ffeste_emit_line_note_ ();
+
     if ((expr == NULL)
 	|| (ffeinfo_basictype (ffebld_info (expr))
 	    == FFEINFO_basictypeANY))
@@ -3184,12 +3647,16 @@ ffeste_R843 (ffebld expr)
 		== FFEINFO_kindtypeCHARACTERDEFAULT);
       }
 
-    ffecom_push_calltemps ();
+    /* No need to call ffeste_start_stmt_(), as the sorts of expressions
+       seen here should never require use of temporaries.  */
+
     callit = ffecom_call_gfrt (FFECOM_gfrtPAUSE,
-		    ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)));
-    ffecom_pop_calltemps ();
+		    ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)),
+			       NULL_TREE);
     TREE_SIDE_EFFECTS (callit) = 1;
+
     expand_expr_stmt (callit);
+
     clear_momentary ();
   }
 #if 0				/* Old approach for phantom g77 run-time
@@ -3198,28 +3665,25 @@ ffeste_R843 (ffebld expr)
     tree callit;
 
     ffeste_emit_line_note_ ();
+
     if (expr == NULL)
-      callit = ffecom_call_gfrt (FFECOM_gfrtPAUSENIL, NULL_TREE);
+      callit = ffecom_call_gfrt (FFECOM_gfrtPAUSENIL, NULL_TREE, 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 ();
-      }
+      callit = ffecom_call_gfrt (FFECOM_gfrtPAUSEINT,
+		      ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)),
+				 NULL_TREE);
+    else if (ffeinfo_basictype (ffebld_info (expr))
+	     == FFEINFO_basictypeCHARACTER)
+      callit = ffecom_call_gfrt (FFECOM_gfrtPAUSECHAR,
+		      ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)),
+				 NULL_TREE);
     else
-      {
-	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 ();
-      }
+      abort ();
     TREE_SIDE_EFFECTS (callit) = 1;
+
     expand_expr_stmt (callit);
+
     clear_momentary ();
   }
 #endif
@@ -3228,11 +3692,7 @@ ffeste_R843 (ffebld expr)
 #endif
 }
 
-/* ffeste_R904 -- OPEN statement
-
-   ffeste_R904();
-
-   Make sure an OPEN is valid in the current context, and implement it.	 */
+/* OPEN statement.  */
 
 void
 ffeste_R904 (ffestpOpenStmt *info)
@@ -3277,23 +3737,16 @@ ffeste_R904 (ffestpOpenStmt *info)
     bool iostat;
     bool errl;
 
-#define specified(something) (info->open_spec[something].kw_or_val_present)
-
     ffeste_emit_line_note_ ();
 
+#define specified(something) (info->open_spec[something].kw_or_val_present)
+
     iostat = specified (FFESTP_openixIOSTAT);
     errl = specified (FFESTP_openixERR);
 
-    ffecom_push_calltemps ();
+#undef specified
 
-    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]);
+    ffeste_start_stmt_ ();
 
     if (errl)
       {
@@ -3314,31 +3767,48 @@ ffeste_R904 (ffestpOpenStmt *info)
       }
 
     if (iostat)
-      {				/* IOSTAT= */
+      {
+	/* Have IOSTAT= specification.  */
+
 	ffeste_io_iostat_is_temp_ = FALSE;
 	ffeste_io_iostat_ = ffecom_expr
 	  (info->open_spec[FFESTP_openixIOSTAT].u.expr);
       }
     else if (ffeste_io_abort_ != NULL_TREE)
-      {				/* no IOSTAT= but ERR= */
+      {
+	/* Have no IOSTAT= but have ERR=.  */
+
 	ffeste_io_iostat_is_temp_ = TRUE;
 	ffeste_io_iostat_
-	  = ffecom_push_tempvar (ffecom_integer_type_node,
-				 FFETARGET_charactersizeNONE, -1, FALSE);
+	  = ffecom_make_tempvar ("open", ffecom_integer_type_node,
+				 FFETARGET_charactersizeNONE, -1);
       }
     else
-      {				/* no IOSTAT=, or ERR= */
+      {
+	/* No IOSTAT= or ERR= specification.  */
+
 	ffeste_io_iostat_is_temp_ = FALSE;
 	ffeste_io_iostat_ = NULL_TREE;
       }
 
+    /* Now prescan, then convert, all the arguments.  */
+
+    args = ffeste_io_olist_ (errl || iostat,
+			     info->open_spec[FFESTP_openixUNIT].u.expr,
+			     &info->open_spec[FFESTP_openixFILE],
+			     &info->open_spec[FFESTP_openixSTATUS],
+			     &info->open_spec[FFESTP_openixACCESS],
+			     &info->open_spec[FFESTP_openixFORM],
+			     &info->open_spec[FFESTP_openixRECL],
+			     &info->open_spec[FFESTP_openixBLANK]);
+
     /* Don't generate "if (iostat != 0) goto label;" if label is temp abort
        label, since we're gonna fall through to there anyway. */
 
-    ffeste_io_call_ (ffecom_call_gfrt (FFECOM_gfrtFOPEN, args),
-		     !ffeste_io_abort_is_temp_);
+    ffeste_io_call_ (ffecom_call_gfrt (FFECOM_gfrtFOPEN, args, NULL_TREE),
+		     ! ffeste_io_abort_is_temp_);
 
-    /* If we've got a temp label, generate its code here. */
+    /* If we've got a temp label, generate its code here.  */
 
     if (ffeste_io_abort_is_temp_)
       {
@@ -3349,27 +3819,14 @@ ffeste_R904 (ffestpOpenStmt *info)
 	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
+    ffeste_end_stmt_ ();
   }
-
-  clear_momentary ();
 #else
 #error
 #endif
 }
 
-/* ffeste_R907 -- CLOSE statement
-
-   ffeste_R907();
-
-   Make sure a CLOSE is valid in the current context, and implement it.	 */
+/* CLOSE statement.  */
 
 void
 ffeste_R907 (ffestpCloseStmt *info)
@@ -3389,18 +3846,16 @@ ffeste_R907 (ffestpCloseStmt *info)
     bool iostat;
     bool errl;
 
-#define specified(something) (info->close_spec[something].kw_or_val_present)
-
     ffeste_emit_line_note_ ();
 
+#define specified(something) (info->close_spec[something].kw_or_val_present)
+
     iostat = specified (FFESTP_closeixIOSTAT);
     errl = specified (FFESTP_closeixERR);
 
-    ffecom_push_calltemps ();
+#undef specified
 
-    args = ffeste_io_cllist_ (errl || iostat,
-			      info->close_spec[FFESTP_closeixUNIT].u.expr,
-			      &info->close_spec[FFESTP_closeixSTATUS]);
+    ffeste_start_stmt_ ();
 
     if (errl)
       {
@@ -3421,29 +3876,41 @@ ffeste_R907 (ffestpCloseStmt *info)
       }
 
     if (iostat)
-      {				/* IOSTAT= */
+      {
+	/* Have IOSTAT= specification.  */
+
 	ffeste_io_iostat_is_temp_ = FALSE;
 	ffeste_io_iostat_ = ffecom_expr
 	  (info->close_spec[FFESTP_closeixIOSTAT].u.expr);
       }
     else if (ffeste_io_abort_ != NULL_TREE)
-      {				/* no IOSTAT= but ERR= */
+      {
+	/* Have no IOSTAT= but have ERR=.  */
+
 	ffeste_io_iostat_is_temp_ = TRUE;
 	ffeste_io_iostat_
-	  = ffecom_push_tempvar (ffecom_integer_type_node,
-				 FFETARGET_charactersizeNONE, -1, FALSE);
+	  = ffecom_make_tempvar ("close", ffecom_integer_type_node,
+				 FFETARGET_charactersizeNONE, -1);
       }
     else
-      {				/* no IOSTAT=, or ERR= */
+      {
+	/* No IOSTAT= or ERR= specification.  */
+
 	ffeste_io_iostat_is_temp_ = FALSE;
 	ffeste_io_iostat_ = NULL_TREE;
       }
 
+    /* Now prescan, then convert, all the arguments.  */
+
+    args = ffeste_io_cllist_ (errl || iostat,
+			      info->close_spec[FFESTP_closeixUNIT].u.expr,
+			      &info->close_spec[FFESTP_closeixSTATUS]);
+
     /* Don't generate "if (iostat != 0) goto label;" if label is temp abort
        label, since we're gonna fall through to there anyway. */
 
-    ffeste_io_call_ (ffecom_call_gfrt (FFECOM_gfrtFCLOS, args),
-		     !ffeste_io_abort_is_temp_);
+    ffeste_io_call_ (ffecom_call_gfrt (FFECOM_gfrtFCLOS, args, NULL_TREE),
+		     ! ffeste_io_abort_is_temp_);
 
     /* If we've got a temp label, generate its code here. */
 
@@ -3456,28 +3923,14 @@ ffeste_R907 (ffestpCloseStmt *info)
 	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
+    ffeste_end_stmt_ ();
   }
-
-  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.  */
+/* READ(...) statement -- start.  */
 
 void
 ffeste_R909_start (ffestpReadStmt *info, bool only_format UNUSED,
@@ -3553,12 +4006,8 @@ ffeste_R909_start (ffestpReadStmt *info, bool only_format UNUSED,
   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;
@@ -3568,10 +4017,9 @@ ffeste_R909_start (ffestpReadStmt *info, bool only_format UNUSED,
     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
+       call.  The per-item function is picked by choosing an ffeste function
        to call to handle a given item; it knows how to generate a call to the
-       appropriate run-time function, and is called an "io driver".  It
-       handles the implied-DO construct, for example. */
+       appropriate run-time function, and is called an "I/O driver".  */
 
     switch (format)
       {
@@ -3624,45 +4072,34 @@ ffeste_R909_start (ffestpReadStmt *info, bool only_format UNUSED,
       }
     ffeste_io_endgfrt_ = end;
 
+#define specified(something) (info->read_spec[something].kw_or_val_present)
+
     iostat = specified (FFESTP_readixIOSTAT);
     errl = specified (FFESTP_readixERR);
     endl = specified (FFESTP_readixEND);
 
-    ffecom_push_calltemps ();
+#undef specified
 
-    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);
-      }
+    ffeste_start_stmt_ ();
 
     if (errl)
-      {				/* ERR= */
+      {
+	/* Have ERR= specification.   */
+
 	ffeste_io_err_
-	  = ffecom_lookup_label
-	  (info->read_spec[FFESTP_readixERR].u.label);
+	  = ffecom_lookup_label (info->read_spec[FFESTP_readixERR].u.label);
 
 	if (endl)
-	  {			/* ERR= END= */
+	  {
+	    /* Have both ERR= and END=.  Need a temp label to handle both.  */
 	    ffeste_io_end_
-	      = ffecom_lookup_label
-	      (info->read_spec[FFESTP_readixEND].u.label);
+	      = 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= */
+	  {
+	    /* Have ERR= but no END=.  */
 	    ffeste_io_end_ = NULL_TREE;
 	    if ((ffeste_io_abort_is_temp_ = iostat))
 	      ffeste_io_abort_ = ffecom_temp_label ();
@@ -3671,20 +4108,24 @@ ffeste_R909_start (ffestpReadStmt *info, bool only_format UNUSED,
 	  }
       }
     else
-      {				/* no ERR= */
+      {
+	/* No ERR= specification.  */
+
 	ffeste_io_err_ = NULL_TREE;
 	if (endl)
-	  {			/* END= but no ERR= */
+	  {
+	    /* Have END= but no ERR=.  */
 	    ffeste_io_end_
-	      = ffecom_lookup_label
-	      (info->read_spec[FFESTP_readixEND].u.label);
+	      = 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= */
+	  {
+	    /* Have no ERR= or END=.  */
+
 	    ffeste_io_end_ = NULL_TREE;
 	    if ((ffeste_io_abort_is_temp_ = iostat))
 	      ffeste_io_abort_ = ffecom_temp_label ();
@@ -3694,46 +4135,59 @@ ffeste_R909_start (ffestpReadStmt *info, bool only_format UNUSED,
       }
 
     if (iostat)
-      {				/* IOSTAT= */
+      {
+	/* Have IOSTAT= specification.  */
+
 	ffeste_io_iostat_is_temp_ = FALSE;
-	ffeste_io_iostat_ = ffecom_expr
-	  (info->read_spec[FFESTP_readixIOSTAT].u.expr);
+	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 */
+      {
+	/* Have no IOSTAT= but have ERR= and/or END=.  */
+
 	ffeste_io_iostat_is_temp_ = TRUE;
 	ffeste_io_iostat_
-	  = ffecom_push_tempvar (ffecom_integer_type_node,
-				 FFETARGET_charactersizeNONE, -1, FALSE);
+	  = ffecom_make_tempvar ("read", ffecom_integer_type_node,
+				 FFETARGET_charactersizeNONE, -1);
       }
     else
-      {				/* no IOSTAT=, ERR=, or END= */
+      {
+	/* No IOSTAT=, ERR=, or END= specification.  */
+
 	ffeste_io_iostat_is_temp_ = FALSE;
 	ffeste_io_iostat_ = NULL_TREE;
       }
 
+    /* Now prescan, then convert, all the arguments.  */
+
+    if (unit == FFESTV_unitCHAREXPR)
+      cilist = ffeste_io_icilist_ (errl || iostat,
+				   info->read_spec[FFESTP_readixUNIT].u.expr,
+				   endl || iostat, format,
+				   &info->read_spec[FFESTP_readixFORMAT]);
+    else
+      cilist = ffeste_io_cilist_ (errl || iostat, unit,
+				  info->read_spec[FFESTP_readixUNIT].u.expr,
+				  5, endl || iostat, format,
+				  &info->read_spec[FFESTP_readixFORMAT],
+				  rec,
+				  info->read_spec[FFESTP_readixREC].u.expr);
+
     /* If there is no end function, then there are no item functions (i.e.
        it's a NAMELIST), and vice versa by the way.  In this situation, don't
        generate the "if (iostat != 0) goto label;" if the label is temp abort
        label, since we're gonna fall through to there anyway.  */
 
-    ffeste_io_call_ (ffecom_call_gfrt (start, cilist),
-		     !ffeste_io_abort_is_temp_ || (end != FFECOM_gfrt));
+    ffeste_io_call_ (ffecom_call_gfrt (start, cilist, NULL_TREE),
+		     (! 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.  */
+/* READ statement -- I/O item.  */
 
 void
 ffeste_R909_item (ffebld expr, ffelexToken expr_token)
@@ -3746,27 +4200,35 @@ ffeste_R909_item (ffebld expr, ffelexToken expr_token)
 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
   if (expr == NULL)
     return;
+
+  /* Strip parens off items such as in "READ *,(A)".  This is really a bug
+     in the user's code, but I've been told lots of code does this.  */
   while (ffebld_op (expr) == FFEBLD_opPAREN)
-    expr = ffebld_left (expr);	/* "READ *,(A)" -- really a bug in the user's
-				   code, but I've been told lots of code does
-				   this (blech)! */
+    expr = ffebld_left (expr);
+
   if (ffebld_op (expr) == FFEBLD_opANY)
     return;
+
   if (ffebld_op (expr) == FFEBLD_opIMPDO)
     ffeste_io_impdo_ (expr, expr_token);
   else
-    ffeste_io_call_ ((*ffeste_io_driver_) (expr), TRUE);
-  clear_momentary ();
+    {
+      ffeste_start_stmt_ ();
+
+      ffecom_prepare_arg_ptr_to_expr (expr);
+
+      ffecom_prepare_end ();
+
+      ffeste_io_call_ ((*ffeste_io_driver_) (expr), TRUE);
+
+      ffeste_end_stmt_ ();
+    }
 #else
 #error
 #endif
 }
 
-/* ffeste_R909_finish -- READ statement list complete
-
-   ffeste_R909_finish();
-
-   Just wrap up any local activities.  */
+/* READ statement -- end.  */
 
 void
 ffeste_R909_finish ()
@@ -3780,73 +4242,56 @@ ffeste_R909_finish ()
   /* Don't generate "if (iostat != 0) goto label;" if label is temp abort
      label, since we're gonna fall through to there anyway. */
 
-  {
-    if (ffeste_io_endgfrt_ != FFECOM_gfrt)
-      ffeste_io_call_ (ffecom_call_gfrt (ffeste_io_endgfrt_, NULL_TREE),
-		       !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_endgfrt_ != FFECOM_gfrt)
+    ffeste_io_call_ (ffecom_call_gfrt (ffeste_io_endgfrt_, NULL_TREE,
+				       NULL_TREE),
+		     ! ffeste_io_abort_is_temp_);
 
-	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 we've got a temp label, generate its code here and have it fan out
+     to the END= or ERR= label as appropriate. */
 
-	/* 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 (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 we've got a temp iostat, pop the temp. */
+      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 (ffeste_io_iostat_is_temp_)
-      ffecom_pop_tempvar (ffeste_io_iostat_);
+      /* "if (iostat>0) goto err_label;".  */
 
-    ffecom_pop_calltemps ();
+      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 ();
+	}
+    }
 
-    clear_momentary ();
-  }
+  ffeste_end_stmt_ ();
 #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.  */
+/* WRITE statement -- start.  */
 
 void
 ffeste_R910_start (ffestpWriteStmt *info, ffestvUnit unit,
@@ -3900,12 +4345,8 @@ ffeste_R910_start (ffestpWriteStmt *info, ffestvUnit unit,
   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;
@@ -3914,10 +4355,9 @@ ffeste_R910_start (ffestpWriteStmt *info, ffestvUnit unit,
     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
+       call.  The per-item function is picked by choosing an ffeste function
        to call to handle a given item; it knows how to generate a call to the
-       appropriate run-time function, and is called an "io driver".  It
-       handles the implied-DO construct, for example. */
+       appropriate run-time function, and is called an "I/O driver".  */
 
     switch (format)
       {
@@ -3962,32 +4402,21 @@ ffeste_R910_start (ffestpWriteStmt *info, ffestvUnit unit,
       }
     ffeste_io_endgfrt_ = end;
 
+#define specified(something) (info->write_spec[something].kw_or_val_present)
+
     iostat = specified (FFESTP_writeixIOSTAT);
     errl = specified (FFESTP_writeixERR);
 
-    ffecom_push_calltemps ();
+#undef specified
 
-    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_start_stmt_ ();
 
     ffeste_io_end_ = NULL_TREE;
 
     if (errl)
-      {				/* ERR= */
+      {
+	/* Have ERR= specification.   */
+
 	ffeste_io_err_
 	  = ffeste_io_abort_
 	  = ffecom_lookup_label
@@ -3995,7 +4424,9 @@ ffeste_R910_start (ffestpWriteStmt *info, ffestvUnit unit,
 	ffeste_io_abort_is_temp_ = FALSE;
       }
     else
-      {				/* no ERR= */
+      {
+	/* No ERR= specification.  */
+
 	ffeste_io_err_ = NULL_TREE;
 
 	if ((ffeste_io_abort_is_temp_ = iostat))
@@ -4005,46 +4436,59 @@ ffeste_R910_start (ffestpWriteStmt *info, ffestvUnit unit,
       }
 
     if (iostat)
-      {				/* IOSTAT= */
+      {
+	/* Have IOSTAT= specification.  */
+
 	ffeste_io_iostat_is_temp_ = FALSE;
 	ffeste_io_iostat_ = ffecom_expr
 	  (info->write_spec[FFESTP_writeixIOSTAT].u.expr);
       }
     else if (ffeste_io_abort_ != NULL_TREE)
-      {				/* no IOSTAT= but ERR= */
+      {
+	/* Have no IOSTAT= but have ERR=.  */
+
 	ffeste_io_iostat_is_temp_ = TRUE;
 	ffeste_io_iostat_
-	  = ffecom_push_tempvar (ffecom_integer_type_node,
-				 FFETARGET_charactersizeNONE, -1, FALSE);
+	  = ffecom_make_tempvar ("write", ffecom_integer_type_node,
+				 FFETARGET_charactersizeNONE, -1);
       }
     else
-      {				/* no IOSTAT=, or ERR= */
+      {
+	/* No IOSTAT= or ERR= specification.  */
+
 	ffeste_io_iostat_is_temp_ = FALSE;
 	ffeste_io_iostat_ = NULL_TREE;
       }
 
+    /* Now prescan, then convert, all the arguments.  */
+
+    if (unit == FFESTV_unitCHAREXPR)
+      cilist = ffeste_io_icilist_ (errl || iostat,
+				   info->write_spec[FFESTP_writeixUNIT].u.expr,
+				   FALSE, format,
+				   &info->write_spec[FFESTP_writeixFORMAT]);
+    else
+      cilist = ffeste_io_cilist_ (errl || iostat, unit,
+				  info->write_spec[FFESTP_writeixUNIT].u.expr,
+				  6, FALSE, format,
+				  &info->write_spec[FFESTP_writeixFORMAT],
+				  rec,
+				  info->write_spec[FFESTP_writeixREC].u.expr);
+
     /* If there is no end function, then there are no item functions (i.e.
        it's a NAMELIST), and vice versa by the way.  In this situation, don't
        generate the "if (iostat != 0) goto label;" if the label is temp abort
        label, since we're gonna fall through to there anyway.  */
 
-    ffeste_io_call_ (ffecom_call_gfrt (start, cilist),
-		     !ffeste_io_abort_is_temp_ || (end != FFECOM_gfrt));
+    ffeste_io_call_ (ffecom_call_gfrt (start, cilist, NULL_TREE),
+		     (! 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.  */
+/* WRITE statement -- I/O item.  */
 
 void
 ffeste_R910_item (ffebld expr, ffelexToken expr_token)
@@ -4057,23 +4501,30 @@ ffeste_R910_item (ffebld expr, ffelexToken expr_token)
 #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 ();
+    {
+      ffeste_start_stmt_ ();
+
+      ffecom_prepare_arg_ptr_to_expr (expr);
+
+      ffecom_prepare_end ();
+
+      ffeste_io_call_ ((*ffeste_io_driver_) (expr), TRUE);
+
+      ffeste_end_stmt_ ();
+    }
 #else
 #error
 #endif
 }
 
-/* ffeste_R910_finish -- WRITE statement list complete
-
-   ffeste_R910_finish();
-
-   Just wrap up any local activities.  */
+/* WRITE statement -- end.  */
 
 void
 ffeste_R910_finish ()
@@ -4087,45 +4538,29 @@ ffeste_R910_finish ()
   /* Don't generate "if (iostat != 0) goto label;" if label is temp abort
      label, since we're gonna fall through to there anyway. */
 
-  {
-    if (ffeste_io_endgfrt_ != FFECOM_gfrt)
-      ffeste_io_call_ (ffecom_call_gfrt (ffeste_io_endgfrt_, NULL_TREE),
-		       !ffeste_io_abort_is_temp_);
-
-    clear_momentary ();
-    pop_momentary ();
+  if (ffeste_io_endgfrt_ != FFECOM_gfrt)
+    ffeste_io_call_ (ffecom_call_gfrt (ffeste_io_endgfrt_, NULL_TREE,
+				       NULL_TREE),
+		     ! ffeste_io_abort_is_temp_);
 
-    /* If we've got a temp label, generate its code here. */
-
-    if (ffeste_io_abort_is_temp_)
-      {
-	DECL_INITIAL (ffeste_io_abort_) = error_mark_node;
-	emit_nop ();
-	expand_label (ffeste_io_abort_);
-
-	assert (ffeste_io_err_ == NULL_TREE);
-      }
-
-    /* If we've got a temp iostat, pop the temp. */
+  /* If we've got a temp label, generate its code here. */
 
-    if (ffeste_io_iostat_is_temp_)
-      ffecom_pop_tempvar (ffeste_io_iostat_);
+  if (ffeste_io_abort_is_temp_)
+    {
+      DECL_INITIAL (ffeste_io_abort_) = error_mark_node;
+      emit_nop ();
+      expand_label (ffeste_io_abort_);
 
-    ffecom_pop_calltemps ();
+      assert (ffeste_io_err_ == NULL_TREE);
+    }
 
-    clear_momentary ();
-  }
+  ffeste_end_stmt_ ();
 #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.  */
+/* PRINT statement -- start.  */
 
 void
 ffeste_R911_start (ffestpPrintStmt *info, ffestvFormat format)
@@ -4158,18 +4593,15 @@ ffeste_R911_start (ffestpPrintStmt *info, ffestvFormat format)
 
   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
+       call.  The per-item function is picked by choosing an ffeste function
        to call to handle a given item; it knows how to generate a call to the
-       appropriate run-time function, and is called an "io driver".  It
-       handles the implied-DO construct, for example. */
+       appropriate run-time function, and is called an "I/O driver".  */
 
     switch (format)
       {
@@ -4198,10 +4630,7 @@ ffeste_R911_start (ffestpPrintStmt *info, ffestvFormat format)
       }
     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_start_stmt_ ();
 
     ffeste_io_end_ = NULL_TREE;
     ffeste_io_err_ = NULL_TREE;
@@ -4210,26 +4639,25 @@ ffeste_R911_start (ffestpPrintStmt *info, ffestvFormat format)
     ffeste_io_iostat_is_temp_ = FALSE;
     ffeste_io_iostat_ = NULL_TREE;
 
+    /* Now prescan, then convert, all the arguments.  */
+
+    cilist = ffeste_io_cilist_ (FALSE, FFESTV_unitNONE, NULL, 6, FALSE, format,
+		      &info->print_spec[FFESTP_printixFORMAT], FALSE, NULL);
+
     /* If there is no end function, then there are no item functions (i.e.
        it's a NAMELIST), and vice versa by the way.  In this situation, don't
        generate the "if (iostat != 0) goto label;" if the label is temp abort
        label, since we're gonna fall through to there anyway.  */
 
-    ffeste_io_call_ (ffecom_call_gfrt (start, cilist),
-		     !ffeste_io_abort_is_temp_ || (end != FFECOM_gfrt));
+    ffeste_io_call_ (ffecom_call_gfrt (start, cilist, NULL_TREE),
+		     (! 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.  */
+/* PRINT statement -- I/O item.  */
 
 void
 ffeste_R911_item (ffebld expr, ffelexToken expr_token)
@@ -4242,23 +4670,30 @@ ffeste_R911_item (ffebld expr, ffelexToken expr_token)
 #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 ();
+    {
+      ffeste_start_stmt_ ();
+
+      ffecom_prepare_arg_ptr_to_expr (expr);
+
+      ffecom_prepare_end ();
+
+      ffeste_io_call_ ((*ffeste_io_driver_) (expr), TRUE);
+
+      ffeste_end_stmt_ ();
+    }
 #else
 #error
 #endif
 }
 
-/* ffeste_R911_finish -- PRINT statement list complete
-
-   ffeste_R911_finish();
-
-   Just wrap up any local activities.  */
+/* PRINT statement -- end.  */
 
 void
 ffeste_R911_finish ()
@@ -4268,27 +4703,19 @@ ffeste_R911_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 ();
+  if (ffeste_io_endgfrt_ != FFECOM_gfrt)
+    ffeste_io_call_ (ffecom_call_gfrt (ffeste_io_endgfrt_, NULL_TREE,
+				       NULL_TREE),
+		     FALSE);
 
-    clear_momentary ();
-    pop_momentary ();
-    clear_momentary ();
-  }
+  ffeste_end_stmt_ ();
 #else
 #error
 #endif
 }
 
-/* ffeste_R919 -- BACKSPACE statement
-
-   ffeste_R919();
-
-   Make sure a BACKSPACE is valid in the current context, and implement it.  */
+/* BACKSPACE statement.  */
 
 void
 ffeste_R919 (ffestpBeruStmt *info)
@@ -4308,11 +4735,7 @@ ffeste_R919 (ffestpBeruStmt *info)
 #endif
 }
 
-/* ffeste_R920 -- ENDFILE statement
-
-   ffeste_R920();
-
-   Make sure a ENDFILE is valid in the current context, and implement it.  */
+/* ENDFILE statement.  */
 
 void
 ffeste_R920 (ffestpBeruStmt *info)
@@ -4332,11 +4755,7 @@ ffeste_R920 (ffestpBeruStmt *info)
 #endif
 }
 
-/* ffeste_R921 -- REWIND statement
-
-   ffeste_R921();
-
-   Make sure a REWIND is valid in the current context, and implement it.  */
+/* REWIND statement.  */
 
 void
 ffeste_R921 (ffestpBeruStmt *info)
@@ -4356,11 +4775,7 @@ ffeste_R921 (ffestpBeruStmt *info)
 #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.  */
+/* INQUIRE statement (non-IOLENGTH version).  */
 
 void
 ffeste_R923A (ffestpInquireStmt *info, bool by_file UNUSED)
@@ -4413,32 +4828,16 @@ ffeste_R923A (ffestpInquireStmt *info, bool by_file UNUSED)
     bool iostat;
     bool errl;
 
-#define specified(something) (info->inquire_spec[something].kw_or_val_present)
-
     ffeste_emit_line_note_ ();
 
+#define specified(something) (info->inquire_spec[something].kw_or_val_present)
+
     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]);
+#undef specified
+
+    ffeste_start_stmt_ ();
 
     if (errl)
       {
@@ -4459,31 +4858,58 @@ ffeste_R923A (ffestpInquireStmt *info, bool by_file UNUSED)
       }
 
     if (iostat)
-      {				/* IOSTAT= */
+      {
+	/* Have IOSTAT= specification.  */
+
 	ffeste_io_iostat_is_temp_ = FALSE;
 	ffeste_io_iostat_ = ffecom_expr
 	  (info->inquire_spec[FFESTP_inquireixIOSTAT].u.expr);
       }
     else if (ffeste_io_abort_ != NULL_TREE)
-      {				/* no IOSTAT= but ERR= */
+      {
+	/* Have no IOSTAT= but have ERR=.  */
+
 	ffeste_io_iostat_is_temp_ = TRUE;
 	ffeste_io_iostat_
-	  = ffecom_push_tempvar (ffecom_integer_type_node,
-				 FFETARGET_charactersizeNONE, -1, FALSE);
+	  = ffecom_make_tempvar ("inquire", ffecom_integer_type_node,
+				 FFETARGET_charactersizeNONE, -1);
       }
     else
-      {				/* no IOSTAT=, or ERR= */
+      {
+	/* No IOSTAT= or ERR= specification.  */
+
 	ffeste_io_iostat_is_temp_ = FALSE;
 	ffeste_io_iostat_ = NULL_TREE;
       }
 
+    /* Now prescan, then convert, all the arguments.  */
+
+    args
+      = ffeste_io_inlist_ (errl || iostat,
+			   &info->inquire_spec[FFESTP_inquireixUNIT],
+			   &info->inquire_spec[FFESTP_inquireixFILE],
+			   &info->inquire_spec[FFESTP_inquireixEXIST],
+			   &info->inquire_spec[FFESTP_inquireixOPENED],
+			   &info->inquire_spec[FFESTP_inquireixNUMBER],
+			   &info->inquire_spec[FFESTP_inquireixNAMED],
+			   &info->inquire_spec[FFESTP_inquireixNAME],
+			   &info->inquire_spec[FFESTP_inquireixACCESS],
+			   &info->inquire_spec[FFESTP_inquireixSEQUENTIAL],
+			   &info->inquire_spec[FFESTP_inquireixDIRECT],
+			   &info->inquire_spec[FFESTP_inquireixFORM],
+			   &info->inquire_spec[FFESTP_inquireixFORMATTED],
+			   &info->inquire_spec[FFESTP_inquireixUNFORMATTED],
+			   &info->inquire_spec[FFESTP_inquireixRECL],
+			   &info->inquire_spec[FFESTP_inquireixNEXTREC],
+			   &info->inquire_spec[FFESTP_inquireixBLANK]);
+
     /* Don't generate "if (iostat != 0) goto label;" if label is temp abort
        label, since we're gonna fall through to there anyway. */
 
-    ffeste_io_call_ (ffecom_call_gfrt (FFECOM_gfrtFINQU, args),
-		     !ffeste_io_abort_is_temp_);
+    ffeste_io_call_ (ffecom_call_gfrt (FFECOM_gfrtFINQU, args, NULL_TREE),
+		     ! ffeste_io_abort_is_temp_);
 
-    /* If we've got a temp label, generate its code here. */
+    /* If we've got a temp label, generate its code here.  */
 
     if (ffeste_io_abort_is_temp_)
       {
@@ -4494,28 +4920,14 @@ ffeste_R923A (ffestpInquireStmt *info, bool by_file UNUSED)
 	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
+    ffeste_end_stmt_ ();
   }
-
-  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.  */
+/* INQUIRE(IOLENGTH=expr) statement -- start.  */
 
 void
 ffeste_R923B_start (ffestpInquireStmt *info UNUSED)
@@ -4528,18 +4940,14 @@ ffeste_R923B_start (ffestpInquireStmt *info UNUSED)
   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.  */
+/* INQUIRE(IOLENGTH=expr) statement -- I/O item.  */
 
 void
 ffeste_R923B_item (ffebld expr UNUSED)
@@ -4550,17 +4958,12 @@ ffeste_R923B_item (ffebld expr UNUSED)
   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.  */
+/* INQUIRE(IOLENGTH=expr) statement -- end.  */
 
 void
 ffeste_R923B_finish ()
@@ -4570,7 +4973,6 @@ ffeste_R923B_finish ()
 #if FFECOM_targetCURRENT == FFECOM_targetFFE
   fputc ('\n', dmpout);
 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
-  clear_momentary ();
 #else
 #error
 #endif
@@ -4642,9 +5044,7 @@ ffeste_R1001 (ffests s)
 #endif
 }
 
-/* ffeste_R1103 -- End a PROGRAM
-
-   ffeste_R1103();  */
+/* END PROGRAM.  */
 
 void
 ffeste_R1103 ()
@@ -4657,9 +5057,7 @@ ffeste_R1103 ()
 #endif
 }
 
-/* ffeste_R1112 -- End a BLOCK DATA
-
-   ffeste_R1112(TRUE);	*/
+/* END BLOCK DATA.  */
 
 void
 ffeste_R1112 ()
@@ -4672,11 +5070,7 @@ ffeste_R1112 ()
 #endif
 }
 
-/* ffeste_R1212 -- CALL statement
-
-   ffeste_R1212(expr,expr_token);
-
-   Make sure statement is valid here; implement.  */
+/* CALL statement.  */
 
 void
 ffeste_R1212 (ffebld expr)
@@ -4741,6 +5135,27 @@ ffeste_R1212 (ffebld expr)
     else
       ffebld_set_trail (prevargs, NULL);
 
+    ffeste_start_stmt_ ();
+
+    /* No temporaries are actually needed at this level, but we go
+       through the motions anyway, just to be sure in case they do
+       get made.  Temporaries needed for arguments should be in the
+       scopes of inner blocks, and if clean-up actions are supported,
+       such as CALL-ing an intrinsic that writes to an argument of one
+       type when a variable of a different type is provided (requiring
+       assignment to the variable from a temporary after the library
+       routine returns), the clean-up must be done by the expression
+       evaluator, generally, to handle alternate returns (which we hope
+       won't ever be supported by intrinsics, but might be a similar
+       issue, such as CALL-ing an F90-style subroutine with an INTERFACE
+       block).  That implies the expression evaluator will have to
+       recognize the need for its own temporary anyway, meaning it'll
+       construct a block within the one constructed here.  */
+
+    ffecom_prepare_expr (expr);
+
+    ffecom_prepare_end ();
+
     if (labels == NULL)
       expand_expr_stmt (ffecom_expr (expr));
     else
@@ -4751,43 +5166,41 @@ ffeste_R1212 (ffebld expr)
 	int caseno;
 	int pushok;
 	tree duplicate;
+	ffebld label;
 
 	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))
+
+	for (caseno = 1, label = labels;
+	     label != NULL;
+	     ++caseno, label = ffebld_trail (label))
 	  {
 	    value = build_int_2 (caseno, 0);
 	    tlabel = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE);
 
 	    pushok = pushcase (value, convert, tlabel, &duplicate);
 	    assert (pushok == 0);
+
 	    tlabel
-	      = ffecom_lookup_label (ffebld_labter (ffebld_head (labels)));
+	      = ffecom_lookup_label (ffebld_labter (ffebld_head (label)));
 	    if ((tlabel == NULL_TREE)
 		|| (TREE_CODE (tlabel) == ERROR_MARK))
 	      continue;
 	    TREE_USED (tlabel) = 1;
 	    expand_goto (tlabel);
-	    clear_momentary ();
 	  }
 
-	pop_momentary ();
 	expand_end_case (texpr);
       }
-    clear_momentary ();
+
+    ffeste_end_stmt_ ();
   }
 #else
 #error
 #endif
 }
 
-/* ffeste_R1221 -- End a FUNCTION
-
-   ffeste_R1221(TRUE);	*/
+/* END FUNCTION.  */
 
 void
 ffeste_R1221 ()
@@ -4800,9 +5213,7 @@ ffeste_R1221 ()
 #endif
 }
 
-/* ffeste_R1225 -- End a SUBROUTINE
-
-   ffeste_R1225(TRUE);	*/
+/* END SUBROUTINE.  */
 
 void
 ffeste_R1225 ()
@@ -4815,12 +5226,7 @@ ffeste_R1225 ()
 #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.	 */
+/* ENTRY statement.  */
 
 void
 ffeste_R1226 (ffesymbol entry)
@@ -4868,23 +5274,19 @@ ffeste_R1226 (ffesymbol entry)
 
     ffeste_emit_line_note_ ();
 
+    if (label == error_mark_node)
+      return;
+
     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.  */
+/* RETURN statement.  */
 
 void
 ffeste_R1227 (ffestw block UNUSED, ffebld expr)
@@ -4907,7 +5309,12 @@ ffeste_R1227 (ffestw block UNUSED, ffebld expr)
     tree rtn;
 
     ffeste_emit_line_note_ ();
-    ffecom_push_calltemps ();
+
+    ffeste_start_stmt_ ();
+
+    ffecom_prepare_return_expr (expr);
+
+    ffecom_prepare_end ();
 
     rtn = ffecom_return_expr (expr);
 
@@ -4928,20 +5335,14 @@ ffeste_R1227 (ffestw block UNUSED, ffebld expr)
 	  expand_null_return ();
       }
 
-    ffecom_pop_calltemps ();
-    clear_momentary ();
+    ffeste_end_stmt_ ();
   }
 #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.  */
+/* REWRITE statement -- start.  */
 
 #if FFESTR_VXT
 void
@@ -4976,11 +5377,7 @@ ffeste_V018_start (ffestpRewriteStmt *info, ffestvFormat format)
 #endif
 }
 
-/* ffeste_V018_item -- REWRITE statement i/o item
-
-   ffeste_V018_item(expr,expr_token);
-
-   Implement output-list expression.  */
+/* REWRITE statement -- I/O item.  */
 
 void
 ffeste_V018_item (ffebld expr)
@@ -4996,11 +5393,7 @@ ffeste_V018_item (ffebld expr)
 #endif
 }
 
-/* ffeste_V018_finish -- REWRITE statement list complete
-
-   ffeste_V018_finish();
-
-   Just wrap up any local activities.  */
+/* REWRITE statement -- end.  */
 
 void
 ffeste_V018_finish ()
@@ -5015,12 +5408,7 @@ ffeste_V018_finish ()
 #endif
 }
 
-/* ffeste_V019_start -- ACCEPT statement list begin
-
-   ffeste_V019_start();
-
-   Verify that ACCEPT is valid here, and begin accepting items in the
-   list.  */
+/* ACCEPT statement -- start.  */
 
 void
 ffeste_V019_start (ffestpAcceptStmt *info, ffestvFormat format)
@@ -5055,11 +5443,7 @@ ffeste_V019_start (ffestpAcceptStmt *info, ffestvFormat format)
 #endif
 }
 
-/* ffeste_V019_item -- ACCEPT statement i/o item
-
-   ffeste_V019_item(expr,expr_token);
-
-   Implement output-list expression.  */
+/* ACCEPT statement -- I/O item.  */
 
 void
 ffeste_V019_item (ffebld expr)
@@ -5075,11 +5459,7 @@ ffeste_V019_item (ffebld expr)
 #endif
 }
 
-/* ffeste_V019_finish -- ACCEPT statement list complete
-
-   ffeste_V019_finish();
-
-   Just wrap up any local activities.  */
+/* ACCEPT statement -- end.  */
 
 void
 ffeste_V019_finish ()
@@ -5095,12 +5475,7 @@ ffeste_V019_finish ()
 }
 
 #endif
-/* ffeste_V020_start -- TYPE statement list begin
-
-   ffeste_V020_start();
-
-   Verify that TYPE is valid here, and begin accepting items in the
-   list.  */
+/* TYPE statement -- start.  */
 
 void
 ffeste_V020_start (ffestpTypeStmt *info UNUSED,
@@ -5136,11 +5511,7 @@ ffeste_V020_start (ffestpTypeStmt *info UNUSED,
 #endif
 }
 
-/* ffeste_V020_item -- TYPE statement i/o item
-
-   ffeste_V020_item(expr,expr_token);
-
-   Implement output-list expression.  */
+/* TYPE statement -- I/O item.  */
 
 void
 ffeste_V020_item (ffebld expr UNUSED)
@@ -5156,11 +5527,7 @@ ffeste_V020_item (ffebld expr UNUSED)
 #endif
 }
 
-/* ffeste_V020_finish -- TYPE statement list complete
-
-   ffeste_V020_finish();
-
-   Just wrap up any local activities.  */
+/* TYPE statement -- end.  */
 
 void
 ffeste_V020_finish ()
@@ -5175,11 +5542,7 @@ ffeste_V020_finish ()
 #endif
 }
 
-/* ffeste_V021 -- DELETE statement
-
-   ffeste_V021();
-
-   Make sure a DELETE is valid in the current context, and implement it.  */
+/* DELETE statement.  */
 
 #if FFESTR_VXT
 void
@@ -5200,11 +5563,7 @@ ffeste_V021 (ffestpDeleteStmt *info)
 #endif
 }
 
-/* ffeste_V022 -- UNLOCK statement
-
-   ffeste_V022();
-
-   Make sure a UNLOCK is valid in the current context, and implement it.  */
+/* UNLOCK statement.  */
 
 void
 ffeste_V022 (ffestpBeruStmt *info)
@@ -5223,12 +5582,7 @@ ffeste_V022 (ffestpBeruStmt *info)
 #endif
 }
 
-/* ffeste_V023_start -- ENCODE(...) statement list begin
-
-   ffeste_V023_start();
-
-   Verify that ENCODE is valid here, and begin accepting items in the
-   list.  */
+/* ENCODE statement -- start.  */
 
 void
 ffeste_V023_start (ffestpVxtcodeStmt *info)
@@ -5249,11 +5603,7 @@ ffeste_V023_start (ffestpVxtcodeStmt *info)
 #endif
 }
 
-/* ffeste_V023_item -- ENCODE statement i/o item
-
-   ffeste_V023_item(expr,expr_token);
-
-   Implement output-list expression.  */
+/* ENCODE statement -- I/O item.  */
 
 void
 ffeste_V023_item (ffebld expr)
@@ -5269,11 +5619,7 @@ ffeste_V023_item (ffebld expr)
 #endif
 }
 
-/* ffeste_V023_finish -- ENCODE statement list complete
-
-   ffeste_V023_finish();
-
-   Just wrap up any local activities.  */
+/* ENCODE statement -- end.  */
 
 void
 ffeste_V023_finish ()
@@ -5288,12 +5634,7 @@ ffeste_V023_finish ()
 #endif
 }
 
-/* ffeste_V024_start -- DECODE(...) statement list begin
-
-   ffeste_V024_start();
-
-   Verify that DECODE is valid here, and begin accepting items in the
-   list.  */
+/* DECODE statement -- start.  */
 
 void
 ffeste_V024_start (ffestpVxtcodeStmt *info)
@@ -5314,11 +5655,7 @@ ffeste_V024_start (ffestpVxtcodeStmt *info)
 #endif
 }
 
-/* ffeste_V024_item -- DECODE statement i/o item
-
-   ffeste_V024_item(expr,expr_token);
-
-   Implement output-list expression.  */
+/* DECODE statement -- I/O item.  */
 
 void
 ffeste_V024_item (ffebld expr)
@@ -5334,11 +5671,7 @@ ffeste_V024_item (ffebld expr)
 #endif
 }
 
-/* ffeste_V024_finish -- DECODE statement list complete
-
-   ffeste_V024_finish();
-
-   Just wrap up any local activities.  */
+/* DECODE statement -- end.  */
 
 void
 ffeste_V024_finish ()
@@ -5353,12 +5686,7 @@ ffeste_V024_finish ()
 #endif
 }
 
-/* ffeste_V025_start -- DEFINEFILE statement list begin
-
-   ffeste_V025_start();
-
-   Verify that DEFINEFILE is valid here, and begin accepting items in the
-   list.  */
+/* DEFINEFILE statement -- start.  */
 
 void
 ffeste_V025_start ()
@@ -5373,11 +5701,7 @@ ffeste_V025_start ()
 #endif
 }
 
-/* ffeste_V025_item -- DEFINE FILE statement item
-
-   ffeste_V025_item(u,ut,m,mt,n,nt,asv,asvt);
-
-   Implement item.  */
+/* DEFINE FILE statement -- item.  */
 
 void
 ffeste_V025_item (ffebld u, ffebld m, ffebld n, ffebld asv)
@@ -5399,11 +5723,7 @@ ffeste_V025_item (ffebld u, ffebld m, ffebld n, ffebld asv)
 #endif
 }
 
-/* ffeste_V025_finish -- DEFINE FILE statement list complete
-
-   ffeste_V025_finish();
-
-   Just wrap up any local activities.  */
+/* DEFINE FILE statement -- end.  */
 
 void
 ffeste_V025_finish ()
@@ -5418,11 +5738,7 @@ ffeste_V025_finish ()
 #endif
 }
 
-/* ffeste_V026 -- FIND statement
-
-   ffeste_V026();
-
-   Make sure a FIND is valid in the current context, and implement it.	*/
+/* FIND statement.  */
 
 void
 ffeste_V026 (ffestpFindStmt *info)
@@ -5443,3 +5759,11 @@ ffeste_V026 (ffestpFindStmt *info)
 }
 
 #endif
+
+#ifdef ENABLE_CHECKING
+void
+ffeste_terminate_2 (void)
+{
+  assert (! ffeste_top_block_);
+}
+#endif
diff --git a/gcc/f/ste.h b/gcc/f/ste.h
index 2c818759..78e9881 100644
--- a/gcc/f/ste.h
+++ b/gcc/f/ste.h
@@ -62,10 +62,10 @@ 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_R803 (ffestw block, ffebld expr);
+void ffeste_R804 (ffestw block, ffebld expr);
+void ffeste_R805 (ffestw block);
+void ffeste_R806 (ffestw block);
 void ffeste_R807 (ffebld expr);
 void ffeste_R809 (ffestw block, ffebld expr);
 void ffeste_R810 (ffestw block, unsigned long casenum);
@@ -159,7 +159,11 @@ void ffeste_V026 (ffestpFindStmt *info);
 #endif	/* FFECOM_targetCURRENT == FFECOM_targetFFE */
 #define ffeste_terminate_0()
 #define ffeste_terminate_1()
+#ifdef ENABLE_CHECKING
+void ffeste_terminate_2 (void);
+#else
 #define ffeste_terminate_2()
+#endif
 #define ffeste_terminate_3()
 #define ffeste_terminate_4()
 
diff --git a/gcc/f/stw.h b/gcc/f/stw.h
index 7a81d9b..58818a6 100644
--- a/gcc/f/stw.h
+++ b/gcc/f/stw.h
@@ -81,6 +81,7 @@ struct _ffestw_
     tree select_texpr_;		/* tree for end case. */
     bool select_break_;		/* TRUE when CASE should start with gen
 				   "break;". */
+    int ifthen_fake_else_;	/* Number of fake `else' introductions.  */
 #endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC*/
   };
 
@@ -137,6 +138,7 @@ ffestw ffestw_use (ffestw block);
 #define ffestw_do_iter_var(b) ((b)->do_iter_var_)
 #define ffestw_do_iter_var_t(b) ((b)->do_iter_var_t_)
 #define ffestw_do_tvar(b) ((b)->do_tvar_)
+#define ffestw_ifthen_fake_else(b) ((b)->ifthen_fake_else_)
 #define ffestw_init_1()
 #define ffestw_init_2()
 #define ffestw_init_3()
@@ -156,6 +158,7 @@ ffestw ffestw_use (ffestw block);
 #define ffestw_set_do_iter_var(b,v) ((b)->do_iter_var_ = (v))
 #define ffestw_set_do_iter_var_t(b,t) ((b)->do_iter_var_t_ = (t))
 #define ffestw_set_do_tvar(b,d) ((b)->do_tvar_ = (d))
+#define ffestw_set_ifthen_fake_else(b,e) ((b)->ifthen_fake_else_ = (e))
 #define ffestw_set_label(b,l) ((b)->label_ = (l))
 #define ffestw_set_line(b,l) ((b)->line_ = (l))
 #define ffestw_set_name(b,n) ((b)->name_ = (n))
diff --git a/gcc/f/symbol.c b/gcc/f/symbol.c
index 98b27fe..c4bd14d 100644
--- a/gcc/f/symbol.c
+++ b/gcc/f/symbol.c
@@ -255,6 +255,7 @@ ffesymbol_new_ (ffename n)
   s->reported = FALSE;
   s->explicit_where = FALSE;
   s->namelisted = FALSE;
+  s->assigned = FALSE;
 
   ffename_set_symbol (n, s);
 
diff --git a/gcc/f/symbol.h b/gcc/f/symbol.h
index 6082669..0c7262c 100644
--- a/gcc/f/symbol.h
+++ b/gcc/f/symbol.h
@@ -151,11 +151,13 @@ struct _ffesymbol_
 				   away. */
     bool explicit_where;	/* TRUE if INTRINSIC/EXTERNAL explicit. */
     bool namelisted;		/* TRUE if in NAMELIST (needs static alloc). */
+    bool assigned;		/* TRUE if ever ASSIGNed to.  */
   };
 
 #define ffesymbol_accretes(s) ((s)->accretes)
 #define ffesymbol_accretion(s) ((s)->accretion)
 #define ffesymbol_arraysize(s) ((s)->array_size)
+#define ffesymbol_assigned(s) ((s)->assigned)
 #define ffesymbol_attr(s,a) ((s)->attrs & ((ffesymbolAttrs) 1 << (a)))
 #define ffesymbol_attrs(s) ((s)->attrs)
 const char *ffesymbol_attrs_string (ffesymbolAttrs attrs);
@@ -231,6 +233,7 @@ bool ffesymbol_retractable (void);
 #define ffesymbol_set_accretes(s,a) ((s)->accretes = (a))
 #define ffesymbol_set_accretion(s,a) ((s)->accretion = (a))
 #define ffesymbol_set_arraysize(s,a) ((s)->array_size = (a))
+#define ffesymbol_set_assigned(s,a) ((s)->assigned = (a))
 #define ffesymbol_set_attr(s,a) ((s)->attrs |= ((ffesymbolAttrs) 1 << (a)))
 #define ffesymbol_set_attrs(s,a) ((s)->attrs = (a))
 #define ffesymbol_set_common(s,c) ((s)->common = (c))
diff --git a/gcc/f/version.c b/gcc/f/version.c
index de648d5..807dbce 100644
--- a/gcc/f/version.c
+++ b/gcc/f/version.c
@@ -1 +1 @@
-const char *ffe_version_string = "0.5.24-19990405";
+const char *ffe_version_string = "0.5.24-19990417";