X-Git-Url: http://drtracing.org/?a=blobdiff_plain;f=gdb%2Ff-lang.c;h=b914b491529b21f57c9581d2ff0ef5b519dd9614;hb=505106cdc7c816a44bbfee11daf500f4e5e14072;hp=7a5f86109c521b3c3672293b7d93d7ec5d4c498e;hpb=d0352a18a504a4e7b761f6b3264cf11347d8d056;p=deliverable%2Fbinutils-gdb.git

diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index 7a5f86109c..b914b49152 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -1,5 +1,8 @@
 /* Fortran language support routines for GDB, the GNU debugger.
-   Copyright 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
+
+   Copyright (C) 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003,
+   2004, 2005, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+
    Contributed by Motorola.  Adapted from the C parser by Farooq Butt
    (fmbutt@engage.sps.mot.com).
 
@@ -7,7 +10,7 @@
 
    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
-   the Free Software Foundation; either version 2 of the License, or
+   the Free Software Foundation; either version 3 of the License, or
    (at your option) any later version.
 
    This program is distributed in the hope that it will be useful,
@@ -16,9 +19,7 @@
    GNU General Public License for more details.
 
    You should have received a copy of the GNU General Public License
-   along with this program; if not, write to the Free Software
-   Foundation, Inc., 59 Temple Place - Suite 330,
-   Boston, MA 02111-1307, USA.  */
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
 
 #include "defs.h"
 #include "gdb_string.h"
@@ -29,23 +30,8 @@
 #include "language.h"
 #include "f-lang.h"
 #include "valprint.h"
+#include "value.h"
 
-/* The built-in types of F77.  FIXME: integer*4 is missing, plain
-   logical is missing (builtin_type_logical is logical*4).  */
-
-struct type *builtin_type_f_character;
-struct type *builtin_type_f_logical;
-struct type *builtin_type_f_logical_s1;
-struct type *builtin_type_f_logical_s2;
-struct type *builtin_type_f_integer;
-struct type *builtin_type_f_integer_s2;
-struct type *builtin_type_f_real;
-struct type *builtin_type_f_real_s8;
-struct type *builtin_type_f_real_s16;
-struct type *builtin_type_f_complex_s8;
-struct type *builtin_type_f_complex_s16;
-struct type *builtin_type_f_complex_s32;
-struct type *builtin_type_f_void;
 
 /* Following is dubious stuff that had been in the xcoff reader. */
 
@@ -84,12 +70,9 @@ static SAVED_F77_COMMON_PTR allocate_saved_f77_common_node (void);
 static void patch_common_entries (SAVED_F77_COMMON_PTR, CORE_ADDR, int);
 #endif
 
-static struct type *f_create_fundamental_type (struct objfile *, int);
-static void f_printstr (struct ui_file * stream, char *string,
-			unsigned int length, int width,
-			int force_ellipses);
-static void f_printchar (int c, struct ui_file * stream);
-static void f_emit_char (int c, struct ui_file * stream, int quoter);
+static void f_printchar (int c, struct type *type, struct ui_file * stream);
+static void f_emit_char (int c, struct type *type,
+			 struct ui_file * stream, int quoter);
 
 /* Print the character C on STREAM as part of the contents of a literal
    string whose delimiter is QUOTER.  Note that that format for printing
@@ -98,10 +81,7 @@ static void f_emit_char (int c, struct ui_file * stream, int quoter);
    be replaced with a true F77 version.  */
 
 static void
-f_emit_char (c, stream, quoter)
-     register int c;
-     struct ui_file *stream;
-     int quoter;
+f_emit_char (int c, struct type *type, struct ui_file *stream, int quoter)
 {
   c &= 0xFF;			/* Avoid sign bit follies */
 
@@ -147,12 +127,10 @@ f_emit_char (c, stream, quoter)
    be replaced with a true F77version. */
 
 static void
-f_printchar (c, stream)
-     int c;
-     struct ui_file *stream;
+f_printchar (int c, struct type *type, struct ui_file *stream)
 {
   fputs_filtered ("'", stream);
-  LA_EMIT_CHAR (c, stream, '\'');
+  LA_EMIT_CHAR (c, type, stream, '\'');
   fputs_filtered ("'", stream);
 }
 
@@ -164,18 +142,15 @@ f_printchar (c, stream)
    be replaced with a true F77 version. */
 
 static void
-f_printstr (stream, string, length, width, force_ellipses)
-     struct ui_file *stream;
-     char *string;
-     unsigned int length;
-     int width;
-     int force_ellipses;
+f_printstr (struct ui_file *stream, struct type *type, const gdb_byte *string,
+	    unsigned int length, const char *encoding, int force_ellipses,
+	    const struct value_print_options *options)
 {
-  register unsigned int i;
+  unsigned int i;
   unsigned int things_printed = 0;
   int in_quotes = 0;
   int need_comma = 0;
-  extern int inspect_it;
+  int width = TYPE_LENGTH (type);
 
   if (length == 0)
     {
@@ -183,7 +158,7 @@ f_printstr (stream, string, length, width, force_ellipses)
       return;
     }
 
-  for (i = 0; i < length && things_printed < print_max; ++i)
+  for (i = 0; i < length && things_printed < options->print_max; ++i)
     {
       /* Position of the character we are examining
          to see whether it is repeated.  */
@@ -207,33 +182,33 @@ f_printstr (stream, string, length, width, force_ellipses)
 	  ++reps;
 	}
 
-      if (reps > repeat_count_threshold)
+      if (reps > options->repeat_count_threshold)
 	{
 	  if (in_quotes)
 	    {
-	      if (inspect_it)
+	      if (options->inspect_it)
 		fputs_filtered ("\\', ", stream);
 	      else
 		fputs_filtered ("', ", stream);
 	      in_quotes = 0;
 	    }
-	  f_printchar (string[i], stream);
+	  f_printchar (string[i], type, stream);
 	  fprintf_filtered (stream, " <repeats %u times>", reps);
 	  i = rep1 - 1;
-	  things_printed += repeat_count_threshold;
+	  things_printed += options->repeat_count_threshold;
 	  need_comma = 1;
 	}
       else
 	{
 	  if (!in_quotes)
 	    {
-	      if (inspect_it)
+	      if (options->inspect_it)
 		fputs_filtered ("\\'", stream);
 	      else
 		fputs_filtered ("'", stream);
 	      in_quotes = 1;
 	    }
-	  LA_EMIT_CHAR (string[i], stream, '"');
+	  LA_EMIT_CHAR (string[i], type, stream, '"');
 	  ++things_printed;
 	}
     }
@@ -241,7 +216,7 @@ f_printstr (stream, string, length, width, force_ellipses)
   /* Terminate the quotes if necessary.  */
   if (in_quotes)
     {
-      if (inspect_it)
+      if (options->inspect_it)
 	fputs_filtered ("\\'", stream);
       else
 	fputs_filtered ("'", stream);
@@ -250,166 +225,6 @@ f_printstr (stream, string, length, width, force_ellipses)
   if (force_ellipses || i < length)
     fputs_filtered ("...", stream);
 }
-
-/* FIXME:  This is a copy of c_create_fundamental_type(), before
-   all the non-C types were stripped from it.  Needs to be fixed
-   by an experienced F77 programmer. */
-
-static struct type *
-f_create_fundamental_type (objfile, typeid)
-     struct objfile *objfile;
-     int typeid;
-{
-  register struct type *type = NULL;
-
-  switch (typeid)
-    {
-    case FT_VOID:
-      type = init_type (TYPE_CODE_VOID,
-			TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-			0, "VOID", objfile);
-      break;
-    case FT_BOOLEAN:
-      type = init_type (TYPE_CODE_BOOL,
-			TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-			TYPE_FLAG_UNSIGNED, "boolean", objfile);
-      break;
-    case FT_STRING:
-      type = init_type (TYPE_CODE_STRING,
-			TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-			0, "string", objfile);
-      break;
-    case FT_CHAR:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-			0, "character", objfile);
-      break;
-    case FT_SIGNED_CHAR:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-			0, "integer*1", objfile);
-      break;
-    case FT_UNSIGNED_CHAR:
-      type = init_type (TYPE_CODE_BOOL,
-			TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-			TYPE_FLAG_UNSIGNED, "logical*1", objfile);
-      break;
-    case FT_SHORT:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_SHORT_BIT / TARGET_CHAR_BIT,
-			0, "integer*2", objfile);
-      break;
-    case FT_SIGNED_SHORT:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_SHORT_BIT / TARGET_CHAR_BIT,
-			0, "short", objfile);	/* FIXME-fnf */
-      break;
-    case FT_UNSIGNED_SHORT:
-      type = init_type (TYPE_CODE_BOOL,
-			TARGET_SHORT_BIT / TARGET_CHAR_BIT,
-			TYPE_FLAG_UNSIGNED, "logical*2", objfile);
-      break;
-    case FT_INTEGER:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_INT_BIT / TARGET_CHAR_BIT,
-			0, "integer*4", objfile);
-      break;
-    case FT_SIGNED_INTEGER:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_INT_BIT / TARGET_CHAR_BIT,
-			0, "integer", objfile);		/* FIXME -fnf */
-      break;
-    case FT_UNSIGNED_INTEGER:
-      type = init_type (TYPE_CODE_BOOL,
-			TARGET_INT_BIT / TARGET_CHAR_BIT,
-			TYPE_FLAG_UNSIGNED, "logical*4", objfile);
-      break;
-    case FT_FIXED_DECIMAL:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_INT_BIT / TARGET_CHAR_BIT,
-			0, "fixed decimal", objfile);
-      break;
-    case FT_LONG:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_LONG_BIT / TARGET_CHAR_BIT,
-			0, "long", objfile);
-      break;
-    case FT_SIGNED_LONG:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_LONG_BIT / TARGET_CHAR_BIT,
-			0, "long", objfile);	/* FIXME -fnf */
-      break;
-    case FT_UNSIGNED_LONG:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_LONG_BIT / TARGET_CHAR_BIT,
-			TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
-      break;
-    case FT_LONG_LONG:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
-			0, "long long", objfile);
-      break;
-    case FT_SIGNED_LONG_LONG:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
-			0, "signed long long", objfile);
-      break;
-    case FT_UNSIGNED_LONG_LONG:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
-			TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
-      break;
-    case FT_FLOAT:
-      type = init_type (TYPE_CODE_FLT,
-			TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
-			0, "real", objfile);
-      break;
-    case FT_DBL_PREC_FLOAT:
-      type = init_type (TYPE_CODE_FLT,
-			TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
-			0, "real*8", objfile);
-      break;
-    case FT_FLOAT_DECIMAL:
-      type = init_type (TYPE_CODE_FLT,
-			TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
-			0, "floating decimal", objfile);
-      break;
-    case FT_EXT_PREC_FLOAT:
-      type = init_type (TYPE_CODE_FLT,
-			TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
-			0, "real*16", objfile);
-      break;
-    case FT_COMPLEX:
-      type = init_type (TYPE_CODE_COMPLEX,
-			2 * TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
-			0, "complex*8", objfile);
-      TYPE_TARGET_TYPE (type) = builtin_type_f_real;
-      break;
-    case FT_DBL_PREC_COMPLEX:
-      type = init_type (TYPE_CODE_COMPLEX,
-			2 * TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
-			0, "complex*16", objfile);
-      TYPE_TARGET_TYPE (type) = builtin_type_f_real_s8;
-      break;
-    case FT_EXT_PREC_COMPLEX:
-      type = init_type (TYPE_CODE_COMPLEX,
-			2 * TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
-			0, "complex*32", objfile);
-      TYPE_TARGET_TYPE (type) = builtin_type_f_real_s16;
-      break;
-    default:
-      /* FIXME:  For now, if we are asked to produce a type not in this
-         language, create the equivalent of a C integer type with the
-         name "<?type?>".  When all the dust settles from the type
-         reconstruction work, this should probably become an error. */
-      type = init_type (TYPE_CODE_INT,
-			TARGET_INT_BIT / TARGET_CHAR_BIT,
-			0, "<?type?>", objfile);
-      warning ("internal error: no F77 fundamental type %d", typeid);
-      break;
-    }
-  return (type);
-}
 
 
 /* Table of operators and their precedences for printing expressions.  */
@@ -439,144 +254,174 @@ static const struct op_print f_op_print_tab[] =
   {NULL, 0, 0, 0}
 };
 
-struct type **CONST_PTR (f_builtin_types[]) =
-{
-  &builtin_type_f_character,
-    &builtin_type_f_logical,
-    &builtin_type_f_logical_s1,
-    &builtin_type_f_logical_s2,
-    &builtin_type_f_integer,
-    &builtin_type_f_integer_s2,
-    &builtin_type_f_real,
-    &builtin_type_f_real_s8,
-    &builtin_type_f_real_s16,
-    &builtin_type_f_complex_s8,
-    &builtin_type_f_complex_s16,
-#if 0
-    &builtin_type_f_complex_s32,
-#endif
-    &builtin_type_f_void,
-    0
+enum f_primitive_types {
+  f_primitive_type_character,
+  f_primitive_type_logical,
+  f_primitive_type_logical_s1,
+  f_primitive_type_logical_s2,
+  f_primitive_type_integer,
+  f_primitive_type_integer_s2,
+  f_primitive_type_real,
+  f_primitive_type_real_s8,
+  f_primitive_type_real_s16,
+  f_primitive_type_complex_s8,
+  f_primitive_type_complex_s16,
+  f_primitive_type_void,
+  nr_f_primitive_types
 };
 
+static void
+f_language_arch_info (struct gdbarch *gdbarch,
+		      struct language_arch_info *lai)
+{
+  const struct builtin_f_type *builtin = builtin_f_type (gdbarch);
+
+  lai->string_char_type = builtin->builtin_character;
+  lai->primitive_type_vector
+    = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_f_primitive_types + 1,
+                              struct type *);
+
+  lai->primitive_type_vector [f_primitive_type_character]
+    = builtin->builtin_character;
+  lai->primitive_type_vector [f_primitive_type_logical]
+    = builtin->builtin_logical;
+  lai->primitive_type_vector [f_primitive_type_logical_s1]
+    = builtin->builtin_logical_s1;
+  lai->primitive_type_vector [f_primitive_type_logical_s2]
+    = builtin->builtin_logical_s2;
+  lai->primitive_type_vector [f_primitive_type_real]
+    = builtin->builtin_real;
+  lai->primitive_type_vector [f_primitive_type_real_s8]
+    = builtin->builtin_real_s8;
+  lai->primitive_type_vector [f_primitive_type_real_s16]
+    = builtin->builtin_real_s16;
+  lai->primitive_type_vector [f_primitive_type_complex_s8]
+    = builtin->builtin_complex_s8;
+  lai->primitive_type_vector [f_primitive_type_complex_s16]
+    = builtin->builtin_complex_s16;
+  lai->primitive_type_vector [f_primitive_type_void]
+    = builtin->builtin_void;
+
+  lai->bool_type_symbol = "logical";
+  lai->bool_type_default = builtin->builtin_logical_s2;
+}
+
 /* This is declared in c-lang.h but it is silly to import that file for what
    is already just a hack. */
-extern int c_value_print (struct value *, struct ui_file *, int,
-			  enum val_prettyprint);
+extern int c_value_print (struct value *, struct ui_file *,
+			  const struct value_print_options *);
 
 const struct language_defn f_language_defn =
 {
   "fortran",
   language_fortran,
-  f_builtin_types,
   range_check_on,
   type_check_on,
+  case_sensitive_off,
+  array_column_major,
+  macro_expansion_no,
+  &exp_descriptor_standard,
   f_parse,			/* parser */
   f_error,			/* parser error function */
-  evaluate_subexp_standard,
+  null_post_parser,
   f_printchar,			/* Print character constant */
   f_printstr,			/* function to print string constant */
   f_emit_char,			/* Function to print a single character */
-  f_create_fundamental_type,	/* Create fundamental type in this language */
   f_print_type,			/* Print a type using appropriate syntax */
+  default_print_typedef,	/* Print a typedef using appropriate syntax */
   f_val_print,			/* Print a value using appropriate syntax */
   c_value_print,		/* FIXME */
-  {"", "", "", ""},		/* Binary format info */
-  {"0%o", "0", "o", ""},	/* Octal format info */
-  {"%d", "", "d", ""},		/* Decimal format info */
-  {"0x%x", "0x", "x", ""},	/* Hex format info */
+  NULL,				/* Language specific skip_trampoline */
+  NULL,                    	/* name_of_this */
+  basic_lookup_symbol_nonlocal,	/* lookup_symbol_nonlocal */
+  basic_lookup_transparent_type,/* lookup_transparent_type */
+  NULL,				/* Language specific symbol demangler */
+  NULL,				/* Language specific class_name_from_physname */
   f_op_print_tab,		/* expression operators for printing */
   0,				/* arrays are first-class (not c-style) */
   1,				/* String lower bound */
-  &builtin_type_f_character,	/* Type of string elements */
+  default_word_break_characters,
+  default_make_symbol_completion_list,
+  f_language_arch_info,
+  default_print_array_index,
+  default_pass_by_reference,
+  default_get_string,
   LANG_MAGIC
 };
 
+static void *
+build_fortran_types (struct gdbarch *gdbarch)
+{
+  struct builtin_f_type *builtin_f_type
+    = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_f_type);
+
+  builtin_f_type->builtin_void
+    = arch_type (gdbarch, TYPE_CODE_VOID, 1, "VOID");
+
+  builtin_f_type->builtin_character
+    = arch_integer_type (gdbarch, TARGET_CHAR_BIT, 0, "character");
+
+  builtin_f_type->builtin_logical_s1
+    = arch_boolean_type (gdbarch, TARGET_CHAR_BIT, 1, "logical*1");
+
+  builtin_f_type->builtin_integer_s2
+    = arch_integer_type (gdbarch, gdbarch_short_bit (gdbarch), 0,
+			 "integer*2");
+
+  builtin_f_type->builtin_logical_s2
+    = arch_boolean_type (gdbarch, gdbarch_short_bit (gdbarch), 1,
+			 "logical*2");
+
+  builtin_f_type->builtin_integer
+    = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 0,
+			 "integer");
+
+  builtin_f_type->builtin_logical
+    = arch_boolean_type (gdbarch, gdbarch_int_bit (gdbarch), 1,
+			 "logical*4");
+
+  builtin_f_type->builtin_real
+    = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch),
+		       "real", NULL);
+  builtin_f_type->builtin_real_s8
+    = arch_float_type (gdbarch, gdbarch_double_bit (gdbarch),
+		       "real*8", NULL);
+  builtin_f_type->builtin_real_s16
+    = arch_float_type (gdbarch, gdbarch_long_double_bit (gdbarch),
+		       "real*16", NULL);
+
+  builtin_f_type->builtin_complex_s8
+    = arch_complex_type (gdbarch, "complex*8",
+			 builtin_f_type->builtin_real);
+  builtin_f_type->builtin_complex_s16
+    = arch_complex_type (gdbarch, "complex*16",
+			 builtin_f_type->builtin_real_s8);
+  builtin_f_type->builtin_complex_s32
+    = arch_complex_type (gdbarch, "complex*32",
+			 builtin_f_type->builtin_real_s16);
+
+  return builtin_f_type;
+}
+
+static struct gdbarch_data *f_type_data;
+
+const struct builtin_f_type *
+builtin_f_type (struct gdbarch *gdbarch)
+{
+  return gdbarch_data (gdbarch, f_type_data);
+}
+
 void
-_initialize_f_language ()
+_initialize_f_language (void)
 {
-  builtin_type_f_void =
-    init_type (TYPE_CODE_VOID, 1,
-	       0,
-	       "VOID", (struct objfile *) NULL);
-
-  builtin_type_f_character =
-    init_type (TYPE_CODE_INT, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-	       0,
-	       "character", (struct objfile *) NULL);
-
-  builtin_type_f_logical_s1 =
-    init_type (TYPE_CODE_BOOL, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-	       TYPE_FLAG_UNSIGNED,
-	       "logical*1", (struct objfile *) NULL);
-
-  builtin_type_f_integer_s2 =
-    init_type (TYPE_CODE_INT, TARGET_SHORT_BIT / TARGET_CHAR_BIT,
-	       0,
-	       "integer*2", (struct objfile *) NULL);
-
-  builtin_type_f_logical_s2 =
-    init_type (TYPE_CODE_BOOL, TARGET_SHORT_BIT / TARGET_CHAR_BIT,
-	       TYPE_FLAG_UNSIGNED,
-	       "logical*2", (struct objfile *) NULL);
-
-  builtin_type_f_integer =
-    init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
-	       0,
-	       "integer", (struct objfile *) NULL);
-
-  builtin_type_f_logical =
-    init_type (TYPE_CODE_BOOL, TARGET_INT_BIT / TARGET_CHAR_BIT,
-	       TYPE_FLAG_UNSIGNED,
-	       "logical*4", (struct objfile *) NULL);
-
-  builtin_type_f_real =
-    init_type (TYPE_CODE_FLT, TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
-	       0,
-	       "real", (struct objfile *) NULL);
-
-  builtin_type_f_real_s8 =
-    init_type (TYPE_CODE_FLT, TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
-	       0,
-	       "real*8", (struct objfile *) NULL);
-
-  builtin_type_f_real_s16 =
-    init_type (TYPE_CODE_FLT, TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
-	       0,
-	       "real*16", (struct objfile *) NULL);
-
-  builtin_type_f_complex_s8 =
-    init_type (TYPE_CODE_COMPLEX, 2 * TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
-	       0,
-	       "complex*8", (struct objfile *) NULL);
-  TYPE_TARGET_TYPE (builtin_type_f_complex_s8) = builtin_type_f_real;
-
-  builtin_type_f_complex_s16 =
-    init_type (TYPE_CODE_COMPLEX, 2 * TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
-	       0,
-	       "complex*16", (struct objfile *) NULL);
-  TYPE_TARGET_TYPE (builtin_type_f_complex_s16) = builtin_type_f_real_s8;
-
-  /* We have a new size == 4 double floats for the
-     complex*32 data type */
-
-  builtin_type_f_complex_s32 =
-    init_type (TYPE_CODE_COMPLEX, 2 * TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
-	       0,
-	       "complex*32", (struct objfile *) NULL);
-  TYPE_TARGET_TYPE (builtin_type_f_complex_s32) = builtin_type_f_real_s16;
-
-  builtin_type_string =
-    init_type (TYPE_CODE_STRING, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-	       0,
-	       "character string", (struct objfile *) NULL);
+  f_type_data = gdbarch_data_register_post_init (build_fortran_types);
 
   add_language (&f_language_defn);
 }
 
 #if 0
 static SAVED_BF_PTR
-allocate_saved_bf_node ()
+allocate_saved_bf_node (void)
 {
   SAVED_BF_PTR new;
 
@@ -585,7 +430,7 @@ allocate_saved_bf_node ()
 }
 
 static SAVED_FUNCTION *
-allocate_saved_function_node ()
+allocate_saved_function_node (void)
 {
   SAVED_FUNCTION *new;
 
@@ -594,7 +439,7 @@ allocate_saved_function_node ()
 }
 
 static SAVED_F77_COMMON_PTR
-allocate_saved_f77_common_node ()
+allocate_saved_f77_common_node (void)
 {
   SAVED_F77_COMMON_PTR new;
 
@@ -603,7 +448,7 @@ allocate_saved_f77_common_node ()
 }
 
 static COMMON_ENTRY_PTR
-allocate_common_entry_node ()
+allocate_common_entry_node (void)
 {
   COMMON_ENTRY_PTR new;
 
@@ -630,11 +475,7 @@ static SAVED_BF_PTR tmp_bf_ptr;	/* Generic temporary for use
    the global common block chain */
 
 static void
-add_common_block (name, offset, secnum, func_stab)
-     char *name;
-     CORE_ADDR offset;
-     int secnum;
-     char *func_stab;
+add_common_block (char *name, CORE_ADDR offset, int secnum, char *func_stab)
 {
   SAVED_F77_COMMON_PTR tmp;
   char *c, *local_copy_func_stab;
@@ -645,11 +486,11 @@ add_common_block (name, offset, secnum, func_stab)
      parser have fits. */
 
 
-  if (STREQ (name, BLANK_COMMON_NAME_ORIGINAL) ||
-      STREQ (name, BLANK_COMMON_NAME_MF77))
+  if (strcmp (name, BLANK_COMMON_NAME_ORIGINAL) == 0
+      || strcmp (name, BLANK_COMMON_NAME_MF77) == 0)
     {
 
-      free (name);
+      xfree (name);
       name = alloca (strlen (BLANK_COMMON_NAME_LOCAL) + 1);
       strcpy (name, BLANK_COMMON_NAME_LOCAL);
     }
@@ -671,7 +512,7 @@ add_common_block (name, offset, secnum, func_stab)
   if (c)
     *c = '\0';
   else
-    error ("Malformed function STAB found in add_common_block()");
+    error (_("Malformed function STAB found in add_common_block()"));
 
 
   tmp->owning_function = xmalloc (strlen (local_copy_func_stab) + 1);
@@ -703,8 +544,7 @@ add_common_block (name, offset, secnum, func_stab)
 
 #if 0
 static void
-add_common_entry (entry_sym_ptr)
-     struct symbol *entry_sym_ptr;
+add_common_entry (struct symbol *entry_sym_ptr)
 {
   COMMON_ENTRY_PTR tmp;
 
@@ -720,7 +560,7 @@ add_common_entry (entry_sym_ptr)
   tmp->symbol = entry_sym_ptr;
 
   if (current_common == NULL)
-    error ("Attempt to add COMMON entry with no block open!");
+    error (_("Attempt to add COMMON entry with no block open!"));
   else
     {
       if (current_common->entries == NULL)
@@ -741,8 +581,7 @@ add_common_entry (entry_sym_ptr)
 
 #if 0
 static SAVED_F77_COMMON_PTR
-find_first_common_named (name)
-     char *name;
+find_first_common_named (char *name)
 {
 
   SAVED_F77_COMMON_PTR tmp;
@@ -751,7 +590,7 @@ find_first_common_named (name)
 
   while (tmp != NULL)
     {
-      if (STREQ (tmp->name, name))
+      if (strcmp (tmp->name, name) == 0)
 	return (tmp);
       else
 	tmp = tmp->next;
@@ -764,9 +603,7 @@ find_first_common_named (name)
    that belongs to function funcname */
 
 SAVED_F77_COMMON_PTR
-find_common_for_function (name, funcname)
-     char *name;
-     char *funcname;
+find_common_for_function (char *name, char *funcname)
 {
 
   SAVED_F77_COMMON_PTR tmp;
@@ -775,7 +612,8 @@ find_common_for_function (name, funcname)
 
   while (tmp != NULL)
     {
-      if (STREQ (tmp->name, name) && STREQ (tmp->owning_function, funcname))
+      if (strcmp (tmp->name, name) == 0
+	  && strcmp (tmp->owning_function, funcname) == 0)
 	return (tmp);
       else
 	tmp = tmp->next;
@@ -791,10 +629,7 @@ find_common_for_function (name, funcname)
    "name."  */
 
 static void
-patch_common_entries (blk, offset, secnum)
-     SAVED_F77_COMMON_PTR blk;
-     CORE_ADDR offset;
-     int secnum;
+patch_common_entries (SAVED_F77_COMMON_PTR blk, CORE_ADDR offset, int secnum)
 {
   COMMON_ENTRY_PTR entry;
 
@@ -819,10 +654,7 @@ patch_common_entries (blk, offset, secnum)
    (which is where common data lives). */
 
 static void
-patch_all_commons_by_name (name, offset, secnum)
-     char *name;
-     CORE_ADDR offset;
-     int secnum;
+patch_all_commons_by_name (char *name, CORE_ADDR offset, int secnum)
 {
 
   SAVED_F77_COMMON_PTR tmp;
@@ -830,10 +662,10 @@ patch_all_commons_by_name (name, offset, secnum)
   /* For blank common blocks, change the canonical reprsentation 
      of a blank name */
 
-  if ((STREQ (name, BLANK_COMMON_NAME_ORIGINAL)) ||
-      (STREQ (name, BLANK_COMMON_NAME_MF77)))
+  if (strcmp (name, BLANK_COMMON_NAME_ORIGINAL) == 0
+      || strcmp (name, BLANK_COMMON_NAME_MF77) == 0)
     {
-      free (name);
+      xfree (name);
       name = alloca (strlen (BLANK_COMMON_NAME_LOCAL) + 1);
       strcpy (name, BLANK_COMMON_NAME_LOCAL);
     }
@@ -843,7 +675,7 @@ patch_all_commons_by_name (name, offset, secnum)
   while (tmp != NULL)
     {
       if (COMMON_NEEDS_PATCHING (tmp))
-	if (STREQ (tmp->name, name))
+	if (strcmp (tmp->name, name) == 0)
 	  patch_common_entries (tmp, offset, secnum);
 
       tmp = tmp->next;
@@ -890,7 +722,7 @@ else \
 
 #if 0
 static void
-clear_bf_list ()
+clear_bf_list (void)
 {
 
   SAVED_BF_PTR tmp = saved_bf_list;
@@ -899,7 +731,7 @@ clear_bf_list ()
   while (tmp != NULL)
     {
       next = tmp->next;
-      free (tmp);
+      xfree (tmp);
       tmp = next;
     }
   saved_bf_list = NULL;
@@ -911,8 +743,7 @@ int global_remote_debug;
 #if 0
 
 static long
-get_bf_for_fcn (the_function)
-     long the_function;
+get_bf_for_fcn (long the_function)
 {
   SAVED_BF_PTR tmp;
   int nprobes = 0;
@@ -921,13 +752,14 @@ get_bf_for_fcn (the_function)
      item at the head of the queue is the one you want)  */
 
   if (saved_bf_list == NULL)
-    internal_error ("cannot get .bf node off empty list");
+    internal_error (__FILE__, __LINE__,
+		    _("cannot get .bf node off empty list"));
 
   if (current_head_bf_list != NULL)
     if (current_head_bf_list->symnum_fcn == the_function)
       {
 	if (global_remote_debug)
-	  fprintf (stderr, "*");
+	  fprintf_unfiltered (gdb_stderr, "*");
 
 	tmp = current_head_bf_list;
 	current_head_bf_list = current_head_bf_list->next;
@@ -939,7 +771,7 @@ get_bf_for_fcn (the_function)
      the ugly linear scan */
 
   if (global_remote_debug)
-    fprintf (stderr, "\ndefaulting to linear scan\n");
+    fprintf_unfiltered (gdb_stderr, "\ndefaulting to linear scan\n");
 
   nprobes = 0;
   tmp = saved_bf_list;
@@ -949,7 +781,7 @@ get_bf_for_fcn (the_function)
       if (tmp->symnum_fcn == the_function)
 	{
 	  if (global_remote_debug)
-	    fprintf (stderr, "Found in %d probes\n", nprobes);
+	    fprintf_unfiltered (gdb_stderr, "Found in %d probes\n", nprobes);
 	  current_head_bf_list = tmp->next;
 	  return (tmp->symnum_bf);
 	}
@@ -963,7 +795,7 @@ static SAVED_FUNCTION_PTR saved_function_list = NULL;
 static SAVED_FUNCTION_PTR saved_function_list_end = NULL;
 
 static void
-clear_function_list ()
+clear_function_list (void)
 {
   SAVED_FUNCTION_PTR tmp = saved_function_list;
   SAVED_FUNCTION_PTR next = NULL;
@@ -971,7 +803,7 @@ clear_function_list ()
   while (tmp != NULL)
     {
       next = tmp->next;
-      free (tmp);
+      xfree (tmp);
       tmp = next;
     }