Gcc 3.3.1-pre as of 2003-07-11.

1 files changed, 307 insertions, 373 deletions

diff --git a/contrib/gcc/f/com.c b/contrib/gcc/f/com.c
index 13de981b793f..fca0f94ac9d6 100644
--- a/contrib/gcc/f/com.c
+++ b/contrib/gcc/f/com.c
@@ -82,6 +82,7 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 
 #include "proj.h"
 #include "flags.h"
+#include "real.h"
 #include "rtl.h"
 #include "toplev.h"
 #include "tree.h"
@@ -92,6 +93,7 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 #include "intl.h"
 #include "langhooks.h"
 #include "langhooks-def.h"
+#include "debug.h"
 
 /* VMS-specific definitions */
 #ifdef VMS
@@ -154,7 +156,7 @@ tree string_type_node;
    inventions should be renamed to be canonical.  Note that only
    the ones currently required to be global are so.  */
 
-static tree ffecom_tree_fun_type_void;
+static GTY(()) tree ffecom_tree_fun_type_void;
 
 tree ffecom_integer_type_node;	/* Abbrev for _tree_type[blah][blah]. */
 tree ffecom_integer_zero_node;	/* Like *_*_* with g77's integer type. */
@@ -165,13 +167,14 @@ tree ffecom_tree_type[FFEINFO_basictype][FFEINFO_kindtype];
    just use build_function_type and build_pointer_type on the
    appropriate _tree_type array element.  */
 
-static tree ffecom_tree_fun_type[FFEINFO_basictype][FFEINFO_kindtype];
-static tree ffecom_tree_ptr_to_fun_type[FFEINFO_basictype][FFEINFO_kindtype];
-static tree ffecom_tree_subr_type;
-static tree ffecom_tree_ptr_to_subr_type;
-static tree ffecom_tree_blockdata_type;
+static GTY(()) tree ffecom_tree_fun_type[FFEINFO_basictype][FFEINFO_kindtype];
+static GTY(()) tree 
+  ffecom_tree_ptr_to_fun_type[FFEINFO_basictype][FFEINFO_kindtype];
+static GTY(()) tree ffecom_tree_subr_type;
+static GTY(()) tree ffecom_tree_ptr_to_subr_type;
+static GTY(()) tree ffecom_tree_blockdata_type;
 
-static tree ffecom_tree_xargc_;
+static GTY(()) tree ffecom_tree_xargc_;
 
 ffecomSymbol ffecom_symbol_null_
 =
@@ -187,10 +190,10 @@ ffeinfoKindtype ffecom_label_kind_ = FFEINFO_basictypeNONE;
 
 int ffecom_f2c_typecode_[FFEINFO_basictype][FFEINFO_kindtype];
 tree ffecom_f2c_integer_type_node;
-tree ffecom_f2c_ptr_to_integer_type_node;
+static GTY(()) tree ffecom_f2c_ptr_to_integer_type_node;
 tree ffecom_f2c_address_type_node;
 tree ffecom_f2c_real_type_node;
-tree ffecom_f2c_ptr_to_real_type_node;
+static GTY(()) tree ffecom_f2c_ptr_to_real_type_node;
 tree ffecom_f2c_doublereal_type_node;
 tree ffecom_f2c_complex_type_node;
 tree ffecom_f2c_doublecomplex_type_node;
@@ -261,6 +264,13 @@ struct _ffecom_concat_list_
 
 /* Static functions (internal). */
 
+static tree ffe_type_for_mode PARAMS ((enum machine_mode, int));
+static tree ffe_type_for_size PARAMS ((unsigned int, int));
+static tree ffe_unsigned_type PARAMS ((tree));
+static tree ffe_signed_type PARAMS ((tree));
+static tree ffe_signed_or_unsigned_type PARAMS ((int, tree));
+static bool ffe_mark_addressable PARAMS ((tree));
+static tree ffe_truthvalue_conversion PARAMS ((tree));
 static void ffecom_init_decl_processing PARAMS ((void));
 static tree ffecom_arglist_expr_ (const char *argstring, ffebld args);
 static tree ffecom_widest_expr_type_ (ffebld list);
@@ -364,9 +374,10 @@ static void delete_block (tree block);
 static int duplicate_decls (tree newdecl, tree olddecl);
 static void finish_decl (tree decl, tree init, bool is_top_level);
 static void finish_function (int nested);
-static const char *lang_printable_name (tree decl, int v);
+static const char *ffe_printable_name (tree decl, int v);
+static void ffe_print_error_function (diagnostic_context *, const char *);
 static tree lookup_name_current_level (tree name);
-static struct binding_level *make_binding_level (void);
+static struct f_binding_level *make_binding_level (void);
 static void pop_f_function_context (void);
 static void push_f_function_context (void);
 static void push_parm_decl (tree parm);
@@ -388,15 +399,15 @@ static ffesymbol ffecom_primary_entry_ = NULL;
 static ffesymbol ffecom_nested_entry_ = NULL;
 static ffeinfoKind ffecom_primary_entry_kind_;
 static bool ffecom_primary_entry_is_proc_;
-static tree ffecom_outer_function_decl_;
-static tree ffecom_previous_function_decl_;
-static tree ffecom_which_entrypoint_decl_;
-static tree ffecom_float_zero_ = NULL_TREE;
-static tree ffecom_float_half_ = NULL_TREE;
-static tree ffecom_double_zero_ = NULL_TREE;
-static tree ffecom_double_half_ = NULL_TREE;
-static tree ffecom_func_result_;/* For functions. */
-static tree ffecom_func_length_;/* For CHARACTER fns. */
+static GTY(()) tree ffecom_outer_function_decl_;
+static GTY(()) tree ffecom_previous_function_decl_;
+static GTY(()) tree ffecom_which_entrypoint_decl_;
+static GTY(()) tree ffecom_float_zero_;
+static GTY(()) tree ffecom_float_half_;
+static GTY(()) tree ffecom_double_zero_;
+static GTY(()) tree ffecom_double_half_;
+static GTY(()) tree ffecom_func_result_;/* For functions. */
+static GTY(()) tree ffecom_func_length_;/* For CHARACTER fns. */
 static ffebld ffecom_list_blockdata_;
 static ffebld ffecom_list_common_;
 static ffebld ffecom_master_arglist_;
@@ -406,9 +417,9 @@ static ffetargetCharacterSize ffecom_master_size_;
 static int ffecom_num_fns_ = 0;
 static int ffecom_num_entrypoints_ = 0;
 static bool ffecom_is_altreturning_ = FALSE;
-static tree ffecom_multi_type_node_;
-static tree ffecom_multi_retval_;
-static tree
+static GTY(()) tree ffecom_multi_type_node_;
+static GTY(()) tree ffecom_multi_retval_;
+static GTY(()) tree
   ffecom_multi_fields_[FFEINFO_basictype][FFEINFO_kindtype];
 static bool ffecom_member_namelisted_;	/* _member_phase1_ namelisted? */
 static bool ffecom_doing_entry_ = FALSE;
@@ -418,13 +429,7 @@ static int ffecom_typesize_integer1_;
 
 /* Holds pointer-to-function expressions.  */
 
-static tree ffecom_gfrt_[FFECOM_gfrt]
-=
-{
-#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX,CONST) NULL_TREE,
-#include "com-rt.def"
-#undef DEFGFRT
-};
+static GTY(()) tree ffecom_gfrt_[FFECOM_gfrt];
 
 /* Holds the external names of the functions.  */
 
@@ -521,7 +526,7 @@ static const char *const ffecom_gfrt_argstring_[FFECOM_gfrt]
 /* Note that the information in the `names' component of the global contour
    is duplicated in the IDENTIFIER_GLOBAL_VALUEs of all identifiers.  */
 
-struct binding_level
+struct f_binding_level GTY(())
   {
     /* A chain of _DECL nodes for all variables, constants, functions,
        and typedef types.  These are in the reverse of the order supplied.
@@ -538,7 +543,7 @@ struct binding_level
     tree this_block;
 
     /* The binding level which this one is contained in (inherits from).  */
-    struct binding_level *level_chain;
+    struct f_binding_level *level_chain;
 
     /* 0: no ffecom_prepare_* functions called at this level yet;
        1: ffecom_prepare* functions called, except not ffecom_prepare_end;
@@ -546,36 +551,38 @@ struct binding_level
     int prep_state;
   };
 
-#define NULL_BINDING_LEVEL (struct binding_level *) NULL
+#define NULL_BINDING_LEVEL (struct f_binding_level *) NULL
 
 /* The binding level currently in effect.  */
 
-static struct binding_level *current_binding_level;
+static GTY(()) struct f_binding_level *current_binding_level;
 
 /* A chain of binding_level structures awaiting reuse.  */
 
-static struct binding_level *free_binding_level;
+static GTY((deletable (""))) struct f_binding_level *free_binding_level;
 
 /* The outermost binding level, for names of file scope.
    This is created when the compiler is started and exists
    through the entire run.  */
 
-static struct binding_level *global_binding_level;
+static struct f_binding_level *global_binding_level;
 
 /* Binding level structures are initialized by copying this one.  */
 
-static const struct binding_level clear_binding_level
+static const struct f_binding_level clear_binding_level
 =
 {NULL, NULL, NULL, NULL_BINDING_LEVEL, 0};
 
 /* Language-dependent contents of an identifier.  */
 
-struct lang_identifier
-  {
-    struct tree_identifier ignore;
-    tree global_value, local_value, label_value;
-    bool invented;
-  };
+struct lang_identifier GTY(())
+{
+  struct tree_identifier common;
+  tree global_value;
+  tree local_value;
+  tree label_value;
+  bool invented;
+};
 
 /* Macros for access to language-specific slots in an identifier.  */
 /* Each of these slots contains a DECL node or null.  */
@@ -596,6 +603,25 @@ struct lang_identifier
 #define IDENTIFIER_INVENTED(NODE)	\
   (((struct lang_identifier *)(NODE))->invented)
 
+/* The resulting tree type.  */
+union lang_tree_node 
+  GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"),
+       chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.generic)")))
+{
+  union tree_node GTY ((tag ("0"), 
+			desc ("tree_node_structure (&%h)"))) 
+    generic;
+  struct lang_identifier GTY ((tag ("1"))) identifier;
+};
+
+/* Fortran doesn't use either of these.  */
+struct lang_decl GTY(()) 
+{
+};
+struct lang_type GTY(())
+{
+};
+
 /* In identifiers, C uses the following fields in a special way:
    TREE_PUBLIC	      to record that there was a previous local extern decl.
    TREE_USED	      to record that such a decl was used.
@@ -605,11 +631,11 @@ struct lang_identifier
    that have names.  Here so we can clear out their names' definitions
    at the end of the function.  */
 
-static tree named_labels;
+static GTY(()) tree named_labels;
 
 /* A list of LABEL_DECLs from outer contexts that are currently shadowed.  */
 
-static tree shadowed_labels;
+static GTY(()) tree shadowed_labels;
 
 /* Return the subscript expression, modified to do range-checking.
 
@@ -780,6 +806,7 @@ ffecom_subscript_check_ (tree array, tree element, int dim, int total_dims,
   die = ffecom_call_gfrt (FFECOM_gfrtRANGE,
 			  args, NULL_TREE);
   TREE_SIDE_EFFECTS (die) = 1;
+  die = convert (void_type_node, die);
 
   element = ffecom_3 (COND_EXPR,
 		      TREE_TYPE (element),
@@ -795,7 +822,7 @@ ffecom_subscript_check_ (tree array, tree element, int dim, int total_dims,
    `item' is NULL_TREE, or the transformed pointer to the array.
    `expr' is the original opARRAYREF expression, which is transformed
      if `item' is NULL_TREE.
-   `want_ptr' is non-zero if a pointer to the element, instead of
+   `want_ptr' is nonzero if a pointer to the element, instead of
      the element itself, is to be returned.  */
 
 static tree
@@ -854,7 +881,7 @@ ffecom_arrayref_ (tree item, ffebld expr, int want_ptr)
 	return item;
 
       if (ffeinfo_where (ffebld_info (expr)) == FFEINFO_whereFLEETING
-	  && ! mark_addressable (item))
+	  && ! ffe_mark_addressable (item))
 	return error_mark_node;
     }
 
@@ -1787,15 +1814,8 @@ ffecom_call_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex,
 				       callee_commons,
 				       scalar_args))
 	{
-#ifdef HOHO
-	  tempvar = ffecom_make_tempvar (ffecom_tree_type
-					 [FFEINFO_basictypeCOMPLEX][kt],
-					 FFETARGET_charactersizeNONE,
-					 -1);
-#else
 	  tempvar = hook;
 	  assert (tempvar);
-#endif
 	}
       else
 	{
@@ -2143,13 +2163,8 @@ ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null)
 	    if (!ffesymbol_hook (s).addr)
 	      item = ffecom_1_fn (item);
 	  }
-
-#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);
@@ -2201,13 +2216,8 @@ ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null)
 	  tree args;
 	  tree newlen;
 
-#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);
@@ -4021,12 +4031,8 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 
     case FFEINTRIN_impCHAR:
     case FFEINTRIN_impACHAR:
-#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)));
 
@@ -5599,7 +5605,6 @@ ffecom_expr_power_integer_ (ffebld expr)
 
     ffecom_start_compstmt ();
 
-#ifndef HAHA
     rtmp = ffecom_make_tempvar ("power_r", rtype,
 				FFETARGET_charactersizeNONE, -1);
     ltmp = ffecom_make_tempvar ("power_l", ltype,
@@ -5612,25 +5617,6 @@ ffecom_expr_power_integer_ (ffebld expr)
 				    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,
@@ -6267,27 +6253,12 @@ ffecom_gfrt_tree_ (ffecomGfrt ix)
 /* A somewhat evil way to prevent the garbage collector
    from collecting 'tree' structures.  */
 #define NUM_TRACKED_CHUNK 63
-static struct tree_ggc_tracker
+struct tree_ggc_tracker GTY(())
 {
   struct tree_ggc_tracker *next;
   tree trees[NUM_TRACKED_CHUNK];
-} *tracker_head = NULL;
-
-static void
-mark_tracker_head (void *arg)
-{
-  struct tree_ggc_tracker *head;
-  int i;
-
-  for (head = * (struct tree_ggc_tracker **) arg;
-       head != NULL;
-       head = head->next)
-  {
-    ggc_mark (head);
-    for (i = 0; i < NUM_TRACKED_CHUNK; i++)
-      ggc_mark_tree (head->trees[i]);
-  }
-}
+};
+static GTY(()) struct tree_ggc_tracker *tracker_head;
 
 void
 ffecom_save_tree_forever (tree t)
@@ -6725,15 +6696,6 @@ 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,
-			     FFETARGET_charactersizeNONE, count, TRUE);
-    item_array = items = ffecom_push_tempvar (ffecom_f2c_address_type_node,
-					      FFETARGET_charactersizeNONE,
-					      count, TRUE);
-#else
     {
       tree hook;
 
@@ -6744,7 +6706,6 @@ ffecom_let_char_ (tree dest_tree, tree dest_length,
       length_array = lengths = TREE_VEC_ELT (hook, 0);
       item_array = items = TREE_VEC_ELT (hook, 1);
     }
-#endif
 
     for (i = 0; i < count; ++i)
       {
@@ -7484,7 +7445,7 @@ ffecom_sym_transform_ (ffesymbol s)
 		assert (et != NULL_TREE);
 
 		if (! TREE_STATIC (et))
-		  put_var_into_stack (et);
+		  put_var_into_stack (et, /*rescan=*/true);
 
 		offset = ffestorag_modulo (est)
 		  + ffestorag_offset (ffesymbol_storage (s))
@@ -8130,8 +8091,8 @@ ffecom_sym_transform_ (ffesymbol s)
 	  DECL_EXTERNAL (t) = 1;
 	  TREE_PUBLIC (t) = 1;
 
-	  t = start_decl (t, FALSE);
-	  finish_decl (t, NULL_TREE, FALSE);
+	  t = start_decl (t, ffe_is_globals ());
+	  finish_decl (t, NULL_TREE, ffe_is_globals ());
 
 	  if ((g != NULL)
 	      && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR)
@@ -9205,15 +9166,13 @@ ffecom_type_localvar_ (ffesymbol s, ffeinfoBasictype bt,
 
 /* Build Namelist type.  */
 
+static GTY(()) tree ffecom_type_namelist_var;
 static tree
 ffecom_type_namelist_ ()
 {
-  static tree type = NULL_TREE;
-
-  if (type == NULL_TREE)
+  if (ffecom_type_namelist_var == NULL_TREE)
     {
-      static tree namefield, varsfield, nvarsfield;
-      tree vardesctype;
+      tree namefield, varsfield, nvarsfield, vardesctype, type;
 
       vardesctype = ffecom_type_vardesc_ ();
 
@@ -9230,22 +9189,21 @@ ffecom_type_namelist_ ()
       TYPE_FIELDS (type) = namefield;
       layout_type (type);
 
-      ggc_add_tree_root (&type, 1);
+      ffecom_type_namelist_var = type;
     }
 
-  return type;
+  return ffecom_type_namelist_var;
 }
 
 /* Build Vardesc type.  */
 
+static GTY(()) tree ffecom_type_vardesc_var;
 static tree
 ffecom_type_vardesc_ ()
 {
-  static tree type = NULL_TREE;
-  static tree namefield, addrfield, dimsfield, typefield;
-
-  if (type == NULL_TREE)
+  if (ffecom_type_vardesc_var == NULL_TREE)
     {
+      tree namefield, addrfield, dimsfield, typefield, type;
       type = make_node (RECORD_TYPE);
 
       namefield = ffecom_decl_field (type, NULL_TREE, "name",
@@ -9260,10 +9218,10 @@ ffecom_type_vardesc_ ()
       TYPE_FIELDS (type) = namefield;
       layout_type (type);
 
-      ggc_add_tree_root (&type, 1);
+      ffecom_type_vardesc_var = type;
     }
 
-  return type;
+  return ffecom_type_vardesc_var;
 }
 
 static tree
@@ -9525,7 +9483,7 @@ ffecom_1 (enum tree_code code, tree type, tree node)
 
   if (code == ADDR_EXPR)
     {
-      if (!mark_addressable (node))
+      if (!ffe_mark_addressable (node))
 	assert ("can't mark_addressable this node!" == NULL);
     }
 
@@ -10251,18 +10209,6 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length)
     /* ~~Kludge! */
     assert (sz != FFETARGET_charactersizeNONE);
 
-#ifdef HOHO
-    length_array
-      = lengths
-      = ffecom_push_tempvar (ffecom_f2c_ftnlen_type_node,
-			     FFETARGET_charactersizeNONE, count, TRUE);
-    item_array
-      = items
-      = ffecom_push_tempvar (ffecom_f2c_address_type_node,
-			     FFETARGET_charactersizeNONE, count, TRUE);
-    temporary = ffecom_push_tempvar (char_type_node,
-				     sz, -1, TRUE);
-#else
     {
       tree hook;
 
@@ -10274,7 +10220,6 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length)
       item_array = items = TREE_VEC_ELT (hook, 1);
       temporary = TREE_VEC_ELT (hook, 2);
     }
-#endif
 
     known_length = ffecom_f2c_ftnlen_zero_node;
 
@@ -10648,6 +10593,78 @@ ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt,
   return item;
 }
 
+/* Transform constant-union to tree, with the type known.  */
+
+tree
+ffecom_constantunion_with_type (ffebldConstantUnion *cu,
+		      tree tree_type, ffebldConst ct)
+{
+  tree item;
+
+  int val;
+
+  switch (ct)
+  {
+#if FFETARGET_okINTEGER1
+	  case  FFEBLD_constINTEGER1:
+         	  val = ffebld_cu_val_integer1 (*cu);
+		  item = build_int_2 (val, (val < 0) ? -1 : 0);
+		  break;
+#endif
+#if FFETARGET_okINTEGER2
+	  case  FFEBLD_constINTEGER2:
+		  val = ffebld_cu_val_integer2 (*cu);
+		  item = build_int_2 (val, (val < 0) ? -1 : 0);
+		  break;
+#endif
+#if FFETARGET_okINTEGER3
+	  case  FFEBLD_constINTEGER3:
+		  val = ffebld_cu_val_integer3 (*cu);
+		  item = build_int_2 (val, (val < 0) ? -1 : 0);
+		  break;
+#endif
+#if FFETARGET_okINTEGER4
+	  case  FFEBLD_constINTEGER4:
+		  val = ffebld_cu_val_integer4 (*cu);
+		  item = build_int_2 (val, (val < 0) ? -1 : 0);
+		  break;
+#endif
+#if FFETARGET_okLOGICAL1
+	  case  FFEBLD_constLOGICAL1:
+		  val = ffebld_cu_val_logical1 (*cu);
+		  item = build_int_2 (val, (val < 0) ? -1 : 0);
+		  break;
+#endif
+#if FFETARGET_okLOGICAL2
+          case  FFEBLD_constLOGICAL2:
+		  val = ffebld_cu_val_logical2 (*cu);
+		  item = build_int_2 (val, (val < 0) ? -1 : 0);
+		  break;
+#endif
+#if FFETARGET_okLOGICAL3
+	  case  FFEBLD_constLOGICAL3:
+		  val = ffebld_cu_val_logical3 (*cu);
+		  item = build_int_2 (val, (val < 0) ? -1 : 0);
+		  break;
+#endif
+#if FFETARGET_okLOGICAL4
+	  case  FFEBLD_constLOGICAL4:
+		  val = ffebld_cu_val_logical4 (*cu);
+		  item = build_int_2 (val, (val < 0) ? -1 : 0);
+		  break;
+#endif
+	  default:
+		  assert ("constant type not supported"==NULL);
+		  return error_mark_node;
+		  break;
+  }
+
+  TREE_TYPE (item) = tree_type;
+
+  TREE_CONSTANT (item) = 1;
+
+  return item;
+}
 /* Transform expression into constant tree.
 
    If the expression can be transformed into a tree that is constant,
@@ -11180,7 +11197,7 @@ ffecom_init_0 ()
 
       name = bsearch ("foo", &names[0], ARRAY_SIZE (names), sizeof (names[0]),
 		      (int (*)(const void *, const void *)) strcmp);
-      if (name != &names[0][2])
+      if (name != &names[2][0])
 	{
 	  assert ("bsearch doesn't work, #define FFEPROJ_BSEARCH 0 in proj.h"
 		  == NULL);
@@ -11724,23 +11741,23 @@ ffecom_init_0 ()
     = build_function_type (void_type_node, NULL_TREE);
 
   builtin_function ("__builtin_sqrtf", float_ftype_float,
-		    BUILT_IN_SQRTF, BUILT_IN_NORMAL, "sqrtf");
+		    BUILT_IN_SQRTF, BUILT_IN_NORMAL, "sqrtf", NULL_TREE);
   builtin_function ("__builtin_sqrt", double_ftype_double,
-		    BUILT_IN_SQRT, BUILT_IN_NORMAL, "sqrt");
+		    BUILT_IN_SQRT, BUILT_IN_NORMAL, "sqrt", NULL_TREE);
   builtin_function ("__builtin_sqrtl", ldouble_ftype_ldouble,
-		    BUILT_IN_SQRTL, BUILT_IN_NORMAL, "sqrtl");
+		    BUILT_IN_SQRTL, BUILT_IN_NORMAL, "sqrtl", NULL_TREE);
   builtin_function ("__builtin_sinf", float_ftype_float,
-		    BUILT_IN_SINF, BUILT_IN_NORMAL, "sinf");
+		    BUILT_IN_SINF, BUILT_IN_NORMAL, "sinf", NULL_TREE);
   builtin_function ("__builtin_sin", double_ftype_double,
-		    BUILT_IN_SIN, BUILT_IN_NORMAL, "sin");
+		    BUILT_IN_SIN, BUILT_IN_NORMAL, "sin", NULL_TREE);
   builtin_function ("__builtin_sinl", ldouble_ftype_ldouble,
-		    BUILT_IN_SINL, BUILT_IN_NORMAL, "sinl");
+		    BUILT_IN_SINL, BUILT_IN_NORMAL, "sinl", NULL_TREE);
   builtin_function ("__builtin_cosf", float_ftype_float,
-		    BUILT_IN_COSF, BUILT_IN_NORMAL, "cosf");
+		    BUILT_IN_COSF, BUILT_IN_NORMAL, "cosf", NULL_TREE);
   builtin_function ("__builtin_cos", double_ftype_double,
-		    BUILT_IN_COS, BUILT_IN_NORMAL, "cos");
+		    BUILT_IN_COS, BUILT_IN_NORMAL, "cos", NULL_TREE);
   builtin_function ("__builtin_cosl", ldouble_ftype_ldouble,
-		    BUILT_IN_COSL, BUILT_IN_NORMAL, "cosl");
+		    BUILT_IN_COSL, BUILT_IN_NORMAL, "cosl", NULL_TREE);
 
   pedantic_lvalues = FALSE;
 
@@ -11804,11 +11821,7 @@ ffecom_init_0 ()
   {
     REAL_VALUE_TYPE point_5;
 
-#ifdef REAL_ARITHMETIC
     REAL_ARITHMETIC (point_5, RDIV_EXPR, dconst1, dconst2);
-#else
-    point_5 = .5;
-#endif
     ffecom_float_half_ = build_real (float_type_node, point_5);
     ffecom_double_half_ = build_real (double_type_node, point_5);
   }
@@ -12466,27 +12479,6 @@ ffecom_prepare_expr_ (ffebld expr, ffebld dest UNUSED)
 	}
       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
@@ -13009,7 +13001,7 @@ ffecom_temp_label ()
 tree
 ffecom_truth_value (tree expr)
 {
-  return truthvalue_conversion (expr);
+  return ffe_truthvalue_conversion (expr);
 }
 
 /* Return the inversion of a truth value (the inversion of what
@@ -13154,12 +13146,14 @@ bison_rule_compstmt_ ()
    See tree.h for its possible values.
 
    If LIBRARY_NAME is nonzero, use that for DECL_ASSEMBLER_NAME,
-   the name to be called if we can't opencode the function.  */
+   the name to be called if we can't opencode the function.  If
+   ATTRS is nonzero, use that for the function's attribute list.  */
 
 tree
 builtin_function (const char *name, tree type, int function_code,
 		  enum built_in_class class,
-		  const char *library_name)
+		  const char *library_name,
+		  tree attrs ATTRIBUTE_UNUSED)
 {
   tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type);
   DECL_EXTERNAL (decl) = 1;
@@ -13639,7 +13633,7 @@ finish_function (int nested)
    nested function and all).  */
 
 static const char *
-lang_printable_name (tree decl, int v)
+ffe_printable_name (tree decl, int v)
 {
   /* Just to keep GCC quiet about the unused variable.
      In theory, differing values of V should produce different
@@ -13657,8 +13651,8 @@ lang_printable_name (tree decl, int v)
    an error.  */
 
 static void
-lang_print_error_function (diagnostic_context *context __attribute__((unused)),
-                           const char *file)
+ffe_print_error_function (diagnostic_context *context __attribute__((unused)),
+			  const char *file)
 {
   static ffeglobal last_g = NULL;
   static ffesymbol last_s = NULL;
@@ -13727,13 +13721,13 @@ lookup_name_current_level (tree name)
   return t;
 }
 
-/* Create a new `struct binding_level'.  */
+/* Create a new `struct f_binding_level'.  */
 
-static struct binding_level *
+static struct f_binding_level *
 make_binding_level ()
 {
   /* NOSTRICT */
-  return (struct binding_level *) xmalloc (sizeof (struct binding_level));
+  return ggc_alloc (sizeof (struct f_binding_level));
 }
 
 /* Save and restore the variables in this file and elsewhere
@@ -13745,7 +13739,7 @@ struct f_function
   struct f_function *next;
   tree named_labels;
   tree shadowed_labels;
-  struct binding_level *binding_level;
+  struct f_binding_level *binding_level;
 };
 
 struct f_function *f_function_chain;
@@ -13833,7 +13827,7 @@ pushdecl_top_level (x)
      tree x;
 {
   register tree t;
-  register struct binding_level *b = current_binding_level;
+  register struct f_binding_level *b = current_binding_level;
   register tree f = current_function_decl;
 
   current_binding_level = global_binding_level;
@@ -13937,7 +13931,7 @@ start_decl (tree decl, bool is_top_level)
 
    Returns 1 on success.  If the DECLARATOR is not suitable for a function
    (it defines a datum instead), we return 0, which tells
-   yyparse to report a parse error.
+   ffe_parse_file to report a parse error.
 
    NESTED is nonzero for a function nested within another function.  */
 
@@ -14054,15 +14048,6 @@ convert (type, expr)
   return error_mark_node;
 }
 
-/* integrate_decl_tree calls this function, but since we don't use the
-   DECL_LANG_SPECIFIC field, this is a no-op.  */
-
-void
-copy_lang_decl (node)
-     tree node UNUSED;
-{
-}
-
 /* Return the list of declarations of the current level.
    Note that this list is in reverse order unless/until
    you nreverse it; and when you do nreverse it, you must
@@ -14082,101 +14067,11 @@ global_bindings_p ()
   return current_binding_level == global_binding_level;
 }
 
-/* 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)
-     tree value UNUSED;
-     tree type;
-{
-  if (TREE_CODE (type) == ERROR_MARK)
-    return;
-
-  assert ("incomplete type?!?" == NULL);
-}
-
-/* Mark ARG for GC.  */
-static void
-mark_binding_level (void *arg)
-{
-  struct binding_level *level = *(struct binding_level **) arg;
-
-  while (level)
-    {
-      ggc_mark_tree (level->names);
-      ggc_mark_tree (level->blocks);
-      ggc_mark_tree (level->this_block);
-      level = level->level_chain;
-    }
-}
-
 static void
 ffecom_init_decl_processing ()
 {
-  static tree *const tree_roots[] = {
-    &current_function_decl,
-    &string_type_node,
-    &ffecom_tree_fun_type_void,
-    &ffecom_integer_zero_node,
-    &ffecom_integer_one_node,
-    &ffecom_tree_subr_type,
-    &ffecom_tree_ptr_to_subr_type,
-    &ffecom_tree_blockdata_type,
-    &ffecom_tree_xargc_,
-    &ffecom_f2c_integer_type_node,
-    &ffecom_f2c_ptr_to_integer_type_node,
-    &ffecom_f2c_address_type_node,
-    &ffecom_f2c_real_type_node,
-    &ffecom_f2c_ptr_to_real_type_node,
-    &ffecom_f2c_doublereal_type_node,
-    &ffecom_f2c_complex_type_node,
-    &ffecom_f2c_doublecomplex_type_node,
-    &ffecom_f2c_longint_type_node,
-    &ffecom_f2c_logical_type_node,
-    &ffecom_f2c_flag_type_node,
-    &ffecom_f2c_ftnlen_type_node,
-    &ffecom_f2c_ftnlen_zero_node,
-    &ffecom_f2c_ftnlen_one_node,
-    &ffecom_f2c_ftnlen_two_node,
-    &ffecom_f2c_ptr_to_ftnlen_type_node,
-    &ffecom_f2c_ftnint_type_node,
-    &ffecom_f2c_ptr_to_ftnint_type_node,
-    &ffecom_outer_function_decl_,
-    &ffecom_previous_function_decl_,
-    &ffecom_which_entrypoint_decl_,
-    &ffecom_float_zero_,
-    &ffecom_float_half_,
-    &ffecom_double_zero_,
-    &ffecom_double_half_,
-    &ffecom_func_result_,
-    &ffecom_func_length_,
-    &ffecom_multi_type_node_,
-    &ffecom_multi_retval_,
-    &named_labels,
-    &shadowed_labels
-  };
-  size_t i;
-
   malloc_init ();
 
-  /* Record our roots.  */
-  for (i = 0; i < ARRAY_SIZE (tree_roots); i++)
-    ggc_add_tree_root (tree_roots[i], 1);
-  ggc_add_tree_root (&ffecom_tree_type[0][0],
-		     FFEINFO_basictype*FFEINFO_kindtype);
-  ggc_add_tree_root (&ffecom_tree_fun_type[0][0],
-		     FFEINFO_basictype*FFEINFO_kindtype);
-  ggc_add_tree_root (&ffecom_tree_ptr_to_fun_type[0][0],
-		     FFEINFO_basictype*FFEINFO_kindtype);
-  ggc_add_tree_root (ffecom_gfrt_, FFECOM_gfrt);
-  ggc_add_root (&current_binding_level, 1, sizeof current_binding_level,
-                mark_binding_level);
-  ggc_add_root (&free_binding_level, 1, sizeof current_binding_level,
-                mark_binding_level);
-  ggc_add_root (&tracker_head, 1, sizeof tracker_head, mark_tracker_head);
-
   ffe_init_0 ();
 }
 
@@ -14219,6 +14114,11 @@ static void ffe_finish PARAMS ((void));
 static void ffe_init_options PARAMS ((void));
 static void ffe_print_identifier PARAMS ((FILE *, tree, int));
 
+struct language_function GTY(())
+{
+  int unused;
+};
+
 #undef  LANG_HOOKS_NAME
 #define LANG_HOOKS_NAME			"GNU F77"
 #undef  LANG_HOOKS_INIT
@@ -14229,8 +14129,29 @@ static void ffe_print_identifier PARAMS ((FILE *, tree, int));
 #define LANG_HOOKS_INIT_OPTIONS		ffe_init_options
 #undef  LANG_HOOKS_DECODE_OPTION
 #define LANG_HOOKS_DECODE_OPTION	ffe_decode_option
+#undef  LANG_HOOKS_PARSE_FILE
+#define LANG_HOOKS_PARSE_FILE		ffe_parse_file
+#undef  LANG_HOOKS_MARK_ADDRESSABLE
+#define LANG_HOOKS_MARK_ADDRESSABLE	ffe_mark_addressable
 #undef  LANG_HOOKS_PRINT_IDENTIFIER
 #define LANG_HOOKS_PRINT_IDENTIFIER	ffe_print_identifier
+#undef  LANG_HOOKS_DECL_PRINTABLE_NAME
+#define LANG_HOOKS_DECL_PRINTABLE_NAME	ffe_printable_name
+#undef  LANG_HOOKS_PRINT_ERROR_FUNCTION
+#define LANG_HOOKS_PRINT_ERROR_FUNCTION ffe_print_error_function
+#undef  LANG_HOOKS_TRUTHVALUE_CONVERSION
+#define LANG_HOOKS_TRUTHVALUE_CONVERSION ffe_truthvalue_conversion
+
+#undef  LANG_HOOKS_TYPE_FOR_MODE
+#define LANG_HOOKS_TYPE_FOR_MODE	ffe_type_for_mode
+#undef  LANG_HOOKS_TYPE_FOR_SIZE
+#define LANG_HOOKS_TYPE_FOR_SIZE	ffe_type_for_size
+#undef  LANG_HOOKS_SIGNED_TYPE
+#define LANG_HOOKS_SIGNED_TYPE		ffe_signed_type
+#undef  LANG_HOOKS_UNSIGNED_TYPE
+#define LANG_HOOKS_UNSIGNED_TYPE	ffe_unsigned_type
+#undef  LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE
+#define LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE ffe_signed_or_unsigned_type
 
 /* We do not wish to use alias-set based aliasing at all.  Used in the
    extreme (every object with its own set, with equivalences recorded) it
@@ -14242,6 +14163,37 @@ static void ffe_print_identifier PARAMS ((FILE *, tree, int));
 
 const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
 
+/* Table indexed by tree code giving a string containing a character
+   classifying the tree code.  Possibilities are
+   t, d, s, c, r, <, 1, 2 and e.  See tree.def for details.  */
+
+#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE,
+
+const char tree_code_type[] = {
+#include "tree.def"
+};
+#undef DEFTREECODE
+
+/* Table indexed by tree code giving number of expression
+   operands beyond the fixed part of the node structure.
+   Not used for types or decls.  */
+
+#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH,
+
+const unsigned char tree_code_length[] = {
+#include "tree.def"
+};
+#undef DEFTREECODE
+
+/* Names of tree components.
+   Used for printing out the tree and error messages.  */
+#define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME,
+
+const char *const tree_code_name[] = {
+#include "tree.def"
+};
+#undef DEFTREECODE
+
 static const char *
 ffe_init (filename)
      const char *filename;
@@ -14262,8 +14214,6 @@ ffe_init (filename)
 #endif
 
   ffecom_init_decl_processing ();
-  decl_printable_name = lang_printable_name;
-  print_error_function = lang_print_error_function;
 
   /* If the file is output from cpp, it should contain a first line
      `# 1 "real-filename"', and the current design of gcc (toplev.c
@@ -14304,8 +14254,8 @@ ffe_init_options ()
   flag_complex_divide_method = 1;
 }
 
-int
-mark_addressable (exp)
+static bool
+ffe_mark_addressable (exp)
      tree exp;
 {
   register tree x = exp;
@@ -14320,7 +14270,7 @@ mark_addressable (exp)
 
       case CONSTRUCTOR:
 	TREE_ADDRESSABLE (x) = 1;
-	return 1;
+	return true;
 
       case VAR_DECL:
       case CONST_DECL:
@@ -14332,7 +14282,7 @@ mark_addressable (exp)
 	    if (TREE_PUBLIC (x))
 	      {
 		assert ("address of global register var requested" == NULL);
-		return 0;
+		return false;
 	      }
 	    assert ("address of register variable requested" == NULL);
 	  }
@@ -14341,11 +14291,11 @@ mark_addressable (exp)
 	    if (TREE_PUBLIC (x))
 	      {
 		assert ("address of global register var requested" == NULL);
-		return 0;
+		return false;
 	      }
 	    assert ("address of register var requested" == NULL);
 	  }
-	put_var_into_stack (x);
+	put_var_into_stack (x, /*rescan=*/true);
 
 	/* drops in */
       case FUNCTION_DECL:
@@ -14356,21 +14306,10 @@ mark_addressable (exp)
 #endif
 
       default:
-	return 1;
+	return true;
       }
 }
 
-/* If DECL has a cleanup, build and return that cleanup here.
-   This is a callback called by expand_expr.  */
-
-tree
-maybe_build_cleanup (decl)
-     tree decl UNUSED;
-{
-  /* There are no cleanups in Fortran.  */
-  return NULL_TREE;
-}
-
 /* Exit a binding level.
    Pop the level off, and restore the state of the identifier-decl mappings
    that were in effect when this level was entered.
@@ -14494,7 +14433,7 @@ poplevel (keep, reverse, functionbody)
   /* Pop the current level, and free the structure for reuse.  */
 
   {
-    register struct binding_level *level = current_binding_level;
+    register struct f_binding_level *level = current_binding_level;
     current_binding_level = current_binding_level->level_chain;
 
     level->level_chain = free_binding_level;
@@ -14549,7 +14488,7 @@ pushdecl (x)
 {
   register tree t;
   register tree name = DECL_NAME (x);
-  register struct binding_level *b = current_binding_level;
+  register struct f_binding_level *b = current_binding_level;
 
   if ((TREE_CODE (x) == FUNCTION_DECL)
       && (DECL_INITIAL (x) == 0)
@@ -14681,7 +14620,7 @@ void
 pushlevel (tag_transparent)
      int tag_transparent;
 {
-  register struct binding_level *newlevel = NULL_BINDING_LEVEL;
+  register struct f_binding_level *newlevel = NULL_BINDING_LEVEL;
 
   assert (! tag_transparent);
 
@@ -14724,8 +14663,8 @@ set_block (block)
 					   BLOCK_SUBBLOCKS (block));
 }
 
-tree
-signed_or_unsigned_type (unsignedp, type)
+static tree
+ffe_signed_or_unsigned_type (unsignedp, type)
      int unsignedp;
      tree type;
 {
@@ -14745,15 +14684,15 @@ signed_or_unsigned_type (unsignedp, type)
     return (unsignedp ? long_long_unsigned_type_node
 	    : long_long_integer_type_node);
 
-  type2 = type_for_size (TYPE_PRECISION (type), unsignedp);
+  type2 = ffe_type_for_size (TYPE_PRECISION (type), unsignedp);
   if (type2 == NULL_TREE)
     return type;
 
   return type2;
 }
 
-tree
-signed_type (type)
+static tree
+ffe_signed_type (type)
      tree type;
 {
   tree type1 = TYPE_MAIN_VARIANT (type);
@@ -14781,7 +14720,7 @@ signed_type (type)
     return intQI_type_node;
 #endif
 
-  type2 = type_for_size (TYPE_PRECISION (type1), 0);
+  type2 = ffe_type_for_size (TYPE_PRECISION (type1), 0);
   if (type2 != NULL_TREE)
     return type2;
 
@@ -14807,8 +14746,8 @@ signed_type (type)
 
    The resulting type should always be `integer_type_node'.  */
 
-tree
-truthvalue_conversion (expr)
+static tree
+ffe_truthvalue_conversion (expr)
      tree expr;
 {
   if (TREE_CODE (expr) == ERROR_MARK)
@@ -14885,31 +14824,38 @@ truthvalue_conversion (expr)
       return ffecom_2 ((TREE_SIDE_EFFECTS (TREE_OPERAND (expr, 1))
 			? TRUTH_OR_EXPR : TRUTH_ORIF_EXPR),
 		       integer_type_node,
-		       truthvalue_conversion (TREE_OPERAND (expr, 0)),
-		       truthvalue_conversion (TREE_OPERAND (expr, 1)));
+		       ffe_truthvalue_conversion (TREE_OPERAND (expr, 0)),
+		       ffe_truthvalue_conversion (TREE_OPERAND (expr, 1)));
 
     case NEGATE_EXPR:
     case ABS_EXPR:
     case FLOAT_EXPR:
     case FFS_EXPR:
-      /* These don't change whether an object is non-zero or zero.  */
-      return truthvalue_conversion (TREE_OPERAND (expr, 0));
+      /* These don't change whether an object is nonzero or zero.  */
+      return ffe_truthvalue_conversion (TREE_OPERAND (expr, 0));
 
     case LROTATE_EXPR:
     case RROTATE_EXPR:
-      /* These don't change whether an object is zero or non-zero, but
+      /* These don't change whether an object is zero or nonzero, but
 	 we can't ignore them if their second arg has side-effects.  */
       if (TREE_SIDE_EFFECTS (TREE_OPERAND (expr, 1)))
 	return build (COMPOUND_EXPR, integer_type_node, TREE_OPERAND (expr, 1),
-		      truthvalue_conversion (TREE_OPERAND (expr, 0)));
+		      ffe_truthvalue_conversion (TREE_OPERAND (expr, 0)));
       else
-	return truthvalue_conversion (TREE_OPERAND (expr, 0));
+	return ffe_truthvalue_conversion (TREE_OPERAND (expr, 0));
 
     case COND_EXPR:
-      /* Distribute the conversion into the arms of a COND_EXPR.  */
-      return fold (build (COND_EXPR, integer_type_node, TREE_OPERAND (expr, 0),
-			  truthvalue_conversion (TREE_OPERAND (expr, 1)),
-			  truthvalue_conversion (TREE_OPERAND (expr, 2))));
+      {
+	/* Distribute the conversion into the arms of a COND_EXPR.  */
+	tree arg1 = TREE_OPERAND (expr, 1);
+	tree arg2 = TREE_OPERAND (expr, 2);
+	if (! VOID_TYPE_P (TREE_TYPE (arg1)))
+	  arg1 = ffe_truthvalue_conversion (arg1);
+	if (! VOID_TYPE_P (TREE_TYPE (arg2)))
+	  arg2 = ffe_truthvalue_conversion (arg2);
+	return fold (build (COND_EXPR, integer_type_node,
+			    TREE_OPERAND (expr, 0), arg1, arg2));
+      }
 
     case CONVERT_EXPR:
       /* Don't cancel the effect of a CONVERT_EXPR from a REFERENCE_TYPE,
@@ -14922,7 +14868,7 @@ truthvalue_conversion (expr)
       /* If this is widening the argument, we can ignore it.  */
       if (TYPE_PRECISION (TREE_TYPE (expr))
 	  >= TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (expr, 0))))
-	return truthvalue_conversion (TREE_OPERAND (expr, 0));
+	return ffe_truthvalue_conversion (TREE_OPERAND (expr, 0));
       break;
 
     case MINUS_EXPR:
@@ -14967,20 +14913,20 @@ truthvalue_conversion (expr)
 	    ((TREE_SIDE_EFFECTS (expr)
 	      ? TRUTH_OR_EXPR : TRUTH_ORIF_EXPR),
 	     integer_type_node,
-	     truthvalue_conversion (ffecom_1 (REALPART_EXPR,
-					      TREE_TYPE (TREE_TYPE (expr)),
-					      expr)),
-	     truthvalue_conversion (ffecom_1 (IMAGPART_EXPR,
-					      TREE_TYPE (TREE_TYPE (expr)),
-					      expr))));
+	     ffe_truthvalue_conversion (ffecom_1 (REALPART_EXPR,
+						  TREE_TYPE (TREE_TYPE (expr)),
+						  expr)),
+	     ffe_truthvalue_conversion (ffecom_1 (IMAGPART_EXPR,
+						  TREE_TYPE (TREE_TYPE (expr)),
+						  expr))));
 
   return ffecom_2 (NE_EXPR, integer_type_node,
 		   expr,
 		   convert (TREE_TYPE (expr), integer_zero_node));
 }
 
-tree
-type_for_mode (mode, unsignedp)
+static tree
+ffe_type_for_mode (mode, unsignedp)
      enum machine_mode mode;
      int unsignedp;
 {
@@ -15039,8 +14985,8 @@ type_for_mode (mode, unsignedp)
   return 0;
 }
 
-tree
-type_for_size (bits, unsignedp)
+static tree
+ffe_type_for_size (bits, unsignedp)
      unsigned bits;
      int unsignedp;
 {
@@ -15075,8 +15021,8 @@ type_for_size (bits, unsignedp)
   return 0;
 }
 
-tree
-unsigned_type (type)
+static tree
+ffe_unsigned_type (type)
      tree type;
 {
   tree type1 = TYPE_MAIN_VARIANT (type);
@@ -15104,7 +15050,7 @@ unsigned_type (type)
     return unsigned_intQI_type_node;
 #endif
 
-  type2 = type_for_size (TYPE_PRECISION (type1), 1);
+  type2 = ffe_type_for_size (TYPE_PRECISION (type1), 1);
   if (type2 != NULL_TREE)
     return type2;
 
@@ -15118,21 +15064,6 @@ unsigned_type (type)
 
   return type;
 }
-
-void
-lang_mark_tree (t)
-     union tree_node *t ATTRIBUTE_UNUSED;
-{
-  if (TREE_CODE (t) == IDENTIFIER_NODE)
-    {
-      struct lang_identifier *i = (struct lang_identifier *) t;
-      ggc_mark_tree (IDENTIFIER_GLOBAL_VALUE (i));
-      ggc_mark_tree (IDENTIFIER_LOCAL_VALUE (i));
-      ggc_mark_tree (IDENTIFIER_LABEL_VALUE (i));
-    }
-  else if (TYPE_P (t) && TYPE_LANG_SPECIFIC (t))
-    ggc_mark (TYPE_LANG_SPECIFIC (t));
-}
 
 /* From gcc/cccp.c, the code to handle -I.  */
 
@@ -15178,7 +15109,7 @@ struct file_name_list
     char *fname;
     /* Mapping of file names for this directory.  */
     struct file_name_map *name_map;
-    /* Non-zero if name_map is valid.  */
+    /* Nonzero if name_map is valid.  */
     int got_name_map;
   };
 
@@ -15465,10 +15396,10 @@ read_name_map (dirname)
 
   dirlen = strlen (dirname);
   separator_needed = dirlen != 0 && dirname[dirlen - 1] != '/';
-  name = (char *) xmalloc (dirlen + strlen (FILE_NAME_MAP_FILE) + 2);
-  strcpy (name, dirname);
-  name[dirlen] = '/';
-  strcpy (name + dirlen + separator_needed, FILE_NAME_MAP_FILE);
+  if (separator_needed)
+    name = concat (dirname, "/", FILE_NAME_MAP_FILE, NULL);
+  else
+    name = concat (dirname, FILE_NAME_MAP_FILE, NULL);
   f = fopen (name, "r");
   free (name);
   if (!f)
@@ -15498,10 +15429,10 @@ read_name_map (dirname)
 	    ptr->map_to = to;
 	  else
 	    {
-	      ptr->map_to = xmalloc (dirlen + strlen (to) + 2);
-	      strcpy (ptr->map_to, dirname);
-	      ptr->map_to[dirlen] = '/';
-	      strcpy (ptr->map_to + dirlen + separator_needed, to);
+	      if (separator_needed)
+		ptr->map_to = concat (dirname, "/", to, NULL);
+	      else
+		ptr->map_to = concat (dirname, to, NULL);
 	      free (to);
 	    }
 
@@ -16205,7 +16136,7 @@ typedef doublereal E_f; // real function with -R not specified //
 
 // (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].) //
+   gcc -ansi.) //
 
 
 
@@ -16636,3 +16567,6 @@ typedef doublereal E_f; // real function with -R not specified //
 -------- (end output file from f2c)
 
 */
+
+#include "gt-f-com.h"
+#include "gtype-f.h"