X-Git-Url: http://drtracing.org/?a=blobdiff_plain;f=gdb%2Ff-typeprint.c;h=1343f68abdaeabcffdde2ce8cf48058c7cf23c43;hb=f55ee35cf17f1eb104292b4c6b2f7def38ffe4a8;hp=12b2865ee70355ca09b902640b255bc45cd3e29d;hpb=dc9e099fc0eced486ae2b49455c9da113c11f4ff;p=deliverable%2Fbinutils-gdb.git

diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c
index 12b2865ee7..1343f68abd 100644
--- a/gdb/f-typeprint.c
+++ b/gdb/f-typeprint.c
@@ -1,5 +1,9 @@
 /* Support for printing Fortran types for GDB, the GNU debugger.
-   Copyright 1986, 1988, 1989, 1991, 1993, 1994 Free Software Foundation, Inc.
+
+   Copyright (C) 1986, 1988, 1989, 1991, 1993, 1994, 1995, 1996, 1998, 2000,
+   2001, 2002, 2003, 2006, 2007, 2008, 2009, 2010
+   Free Software Foundation, Inc.
+
    Contributed by Motorola.  Adapted from the C version by Farooq Butt
    (fmbutt@engage.sps.mot.com).
 
@@ -7,7 +11,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,12 +20,10 @@
    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 "obstack.h"
+#include "gdb_obstack.h"
 #include "bfd.h"
 #include "symtab.h"
 #include "gdbtypes.h"
@@ -29,69 +31,56 @@
 #include "value.h"
 #include "gdbcore.h"
 #include "target.h"
-#include "command.h"
-#include "gdbcmd.h"
-#include "language.h"
-#include "demangle.h"
 #include "f-lang.h"
-#include "typeprint.h"
-#include "frame.h"		/* ??? */
 
 #include "gdb_string.h"
 #include <errno.h>
 
 #if 0				/* Currently unused */
-static void f_type_print_args PARAMS ((struct type *, GDB_FILE *));
+static void f_type_print_args (struct type *, struct ui_file *);
 #endif
 
-static void print_equivalent_f77_float_type PARAMS ((struct type *,
-						     GDB_FILE *));
+static void f_type_print_varspec_suffix (struct type *, struct ui_file *, int,
+					 int, int, int);
 
-static void f_type_print_varspec_suffix PARAMS ((struct type *, GDB_FILE *,
-						 int, int, int));
+void f_type_print_varspec_prefix (struct type *, struct ui_file *,
+				  int, int);
 
-void f_type_print_varspec_prefix PARAMS ((struct type *, GDB_FILE *,
-					  int, int));
-
-void f_type_print_base PARAMS ((struct type *, GDB_FILE *, int, int));
+void f_type_print_base (struct type *, struct ui_file *, int, int);
 
 
 /* LEVEL is the depth to indent lines by.  */
 
 void
-f_print_type (type, varstring, stream, show, level)
-     struct type *type;
-     char *varstring;
-     GDB_FILE *stream;
-     int show;
-     int level;
+f_print_type (struct type *type, char *varstring, struct ui_file *stream,
+	      int show, int level)
 {
-  register enum type_code code;
+  enum type_code code;
   int demangled_args;
 
   f_type_print_base (type, stream, show, level);
   code = TYPE_CODE (type);
   if ((varstring != NULL && *varstring != '\0')
-      ||
   /* Need a space if going to print stars or brackets;
      but not if we will print just a type name.  */
-      ((show > 0 || TYPE_NAME (type) == 0)
-       &&
-       (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC
-	|| code == TYPE_CODE_METHOD
-	|| code == TYPE_CODE_ARRAY
-	|| code == TYPE_CODE_MEMBER
-	|| code == TYPE_CODE_REF)))
+      || ((show > 0 || TYPE_NAME (type) == 0)
+          && (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC
+	      || code == TYPE_CODE_METHOD
+	      || code == TYPE_CODE_ARRAY
+	      || code == TYPE_CODE_REF)))
     fputs_filtered (" ", stream);
   f_type_print_varspec_prefix (type, stream, show, 0);
 
-  fputs_filtered (varstring, stream);
+  if (varstring != NULL)
+    {
+      fputs_filtered (varstring, stream);
 
-  /* For demangled function names, we have the arglist as part of the name,
-     so don't print an additional pair of ()'s */
+      /* For demangled function names, we have the arglist as part of the name,
+         so don't print an additional pair of ()'s */
 
-  demangled_args = varstring[strlen (varstring) - 1] == ')';
-  f_type_print_varspec_suffix (type, stream, show, 0, demangled_args);
+      demangled_args = varstring[strlen (varstring) - 1] == ')'; 
+      f_type_print_varspec_suffix (type, stream, show, 0, demangled_args, 0);
+   }
 }
 
 /* Print any asterisks or open-parentheses needed before the
@@ -103,11 +92,8 @@ f_print_type (type, varstring, stream, show, level)
    SHOW is always zero on recursive calls.  */
 
 void
-f_type_print_varspec_prefix (type, stream, show, passed_a_ptr)
-     struct type *type;
-     GDB_FILE *stream;
-     int show;
-     int passed_a_ptr;
+f_type_print_varspec_prefix (struct type *type, struct ui_file *stream,
+			     int show, int passed_a_ptr)
 {
   if (type == 0)
     return;
@@ -148,7 +134,6 @@ f_type_print_varspec_prefix (type, stream, show, passed_a_ptr)
     case TYPE_CODE_STRING:
     case TYPE_CODE_BITSTRING:
     case TYPE_CODE_METHOD:
-    case TYPE_CODE_MEMBER:
     case TYPE_CODE_REF:
     case TYPE_CODE_COMPLEX:
     case TYPE_CODE_TYPEDEF:
@@ -158,60 +143,19 @@ f_type_print_varspec_prefix (type, stream, show, passed_a_ptr)
     }
 }
 
-#if 0				/* Currently unused */
-
-static void
-f_type_print_args (type, stream)
-     struct type *type;
-     GDB_FILE *stream;
-{
-  int i;
-  struct type **args;
-
-  fprintf_filtered (stream, "(");
-  args = TYPE_ARG_TYPES (type);
-  if (args != NULL)
-    {
-      if (args[1] == NULL)
-	{
-	  fprintf_filtered (stream, "...");
-	}
-      else
-	{
-	  for (i = 1; args[i] != NULL && args[i]->code != TYPE_CODE_VOID; i++)
-	    {
-	      f_print_type (args[i], "", stream, -1, 0);
-	      if (args[i + 1] == NULL)
-		fprintf_filtered (stream, "...");
-	      else if (args[i + 1]->code != TYPE_CODE_VOID)
-		{
-		  fprintf_filtered (stream, ",");
-		  wrap_here ("    ");
-		}
-	    }
-	}
-    }
-  fprintf_filtered (stream, ")");
-}
-
-#endif /* 0 */
-
 /* Print any array sizes, function arguments or close parentheses
    needed after the variable name (to describe its type).
    Args work like c_type_print_varspec_prefix.  */
 
 static void
-f_type_print_varspec_suffix (type, stream, show, passed_a_ptr, demangled_args)
-     struct type *type;
-     GDB_FILE *stream;
-     int show;
-     int passed_a_ptr;
-     int demangled_args;
+f_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
+			     int show, int passed_a_ptr, int demangled_args,
+			     int arrayprint_recurse_level)
 {
   int upper_bound, lower_bound;
-  int lower_bound_was_default = 0;
-  static int arrayprint_recurse_level = 0;
-  int retcode;
+
+  /* No static variables are permitted as an error call may occur during
+     execution of this function.  */
 
   if (type == 0)
     return;
@@ -230,41 +174,27 @@ f_type_print_varspec_suffix (type, stream, show, passed_a_ptr, demangled_args)
 	fprintf_filtered (stream, "(");
 
       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
-	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0);
+	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
+				     arrayprint_recurse_level);
 
-      retcode = f77_get_dynamic_lowerbound (type, &lower_bound);
-
-      lower_bound_was_default = 0;
-
-      if (retcode == BOUND_FETCH_ERROR)
-	fprintf_filtered (stream, "???");
-      else if (lower_bound == 1)	/* The default */
-	lower_bound_was_default = 1;
-      else
-	fprintf_filtered (stream, "%d", lower_bound);
-
-      if (lower_bound_was_default)
-	lower_bound_was_default = 0;
-      else
-	fprintf_filtered (stream, ":");
+      lower_bound = f77_get_lowerbound (type);
+      if (lower_bound != 1)	/* Not the default.  */
+	fprintf_filtered (stream, "%d:", lower_bound);
 
       /* Make sure that, if we have an assumed size array, we
          print out a warning and print the upperbound as '*' */
 
-      if (TYPE_ARRAY_UPPER_BOUND_TYPE (type) == BOUND_CANNOT_BE_DETERMINED)
+      if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
 	fprintf_filtered (stream, "*");
       else
 	{
-	  retcode = f77_get_dynamic_upperbound (type, &upper_bound);
-
-	  if (retcode == BOUND_FETCH_ERROR)
-	    fprintf_filtered (stream, "???");
-	  else
-	    fprintf_filtered (stream, "%d", upper_bound);
+	  upper_bound = f77_get_upperbound (type);
+	  fprintf_filtered (stream, "%d", upper_bound);
 	}
 
       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
-	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0);
+	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
+				     arrayprint_recurse_level);
       if (arrayprint_recurse_level == 1)
 	fprintf_filtered (stream, ")");
       else
@@ -274,13 +204,14 @@ f_type_print_varspec_suffix (type, stream, show, passed_a_ptr, demangled_args)
 
     case TYPE_CODE_PTR:
     case TYPE_CODE_REF:
-      f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0);
+      f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0,
+				   arrayprint_recurse_level);
       fprintf_filtered (stream, ")");
       break;
 
     case TYPE_CODE_FUNC:
       f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
-				   passed_a_ptr, 0);
+				   passed_a_ptr, 0, arrayprint_recurse_level);
       if (passed_a_ptr)
 	fprintf_filtered (stream, ")");
 
@@ -302,7 +233,6 @@ f_type_print_varspec_suffix (type, stream, show, passed_a_ptr, demangled_args)
     case TYPE_CODE_STRING:
     case TYPE_CODE_BITSTRING:
     case TYPE_CODE_METHOD:
-    case TYPE_CODE_MEMBER:
     case TYPE_CODE_COMPLEX:
     case TYPE_CODE_TYPEDEF:
       /* These types do not need a suffix.  They are listed so that
@@ -311,18 +241,6 @@ f_type_print_varspec_suffix (type, stream, show, passed_a_ptr, demangled_args)
     }
 }
 
-static void
-print_equivalent_f77_float_type (type, stream)
-     struct type *type;
-     GDB_FILE *stream;
-{
-  /* Override type name "float" and make it the
-     appropriate real. XLC stupidly outputs -12 as a type
-     for real when it really should be outputting -18 */
-
-  fprintf_filtered (stream, "real*%d", TYPE_LENGTH (type));
-}
-
 /* Print the name of the type (or the ultimate pointer target,
    function value or array element), or the description of a
    structure or union.
@@ -337,14 +255,11 @@ print_equivalent_f77_float_type (type, stream)
    We increase it for some recursive calls.  */
 
 void
-f_type_print_base (type, stream, show, level)
-     struct type *type;
-     GDB_FILE *stream;
-     int show;
-     int level;
+f_type_print_base (struct type *type, struct ui_file *stream, int show,
+		   int level)
 {
-  int retcode;
   int upper_bound;
+  int index;
 
   QUIT;
 
@@ -360,10 +275,7 @@ f_type_print_base (type, stream, show, level)
 
   if ((show <= 0) && (TYPE_NAME (type) != NULL))
     {
-      if (TYPE_CODE (type) == TYPE_CODE_FLT)
-	print_equivalent_f77_float_type (type, stream);
-      else
-	fputs_filtered (TYPE_NAME (type), stream);
+      fputs_filtered (TYPE_NAME (type), stream);
       return;
     }
 
@@ -386,26 +298,31 @@ f_type_print_base (type, stream, show, level)
       f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
       break;
 
+    case TYPE_CODE_REF:
+      fprintf_filtered (stream, "REF TO -> ( ");
+      f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
+      break;
+
     case TYPE_CODE_VOID:
-      fprintf_filtered (stream, "VOID");
+      fprintfi_filtered (level, stream, "VOID");
       break;
 
     case TYPE_CODE_UNDEF:
-      fprintf_filtered (stream, "struct <unknown>");
+      fprintfi_filtered (level, stream, "struct <unknown>");
       break;
 
     case TYPE_CODE_ERROR:
-      fprintf_filtered (stream, "<unknown type>");
+      fprintfi_filtered (level, stream, "<unknown type>");
       break;
 
     case TYPE_CODE_RANGE:
       /* This should not occur */
-      fprintf_filtered (stream, "<range type>");
+      fprintfi_filtered (level, stream, "<range type>");
       break;
 
     case TYPE_CODE_CHAR:
       /* Override name "char" and make it "character" */
-      fprintf_filtered (stream, "character");
+      fprintfi_filtered (level, stream, "character");
       break;
 
     case TYPE_CODE_INT:
@@ -413,36 +330,50 @@ f_type_print_base (type, stream, show, level)
          through as TYPE_CODE_INT since dbxstclass.h is so
          C-oriented, we must change these to "character" from "char".  */
 
-      if (STREQ (TYPE_NAME (type), "char"))
-	fprintf_filtered (stream, "character");
+      if (strcmp (TYPE_NAME (type), "char") == 0)
+	fprintfi_filtered (level, stream, "character");
       else
 	goto default_case;
       break;
 
-    case TYPE_CODE_COMPLEX:
-      fprintf_filtered (stream, "complex*%d", TYPE_LENGTH (type));
-      break;
-
-    case TYPE_CODE_FLT:
-      print_equivalent_f77_float_type (type, stream);
-      break;
-
     case TYPE_CODE_STRING:
       /* Strings may have dynamic upperbounds (lengths) like arrays. */
 
-      if (TYPE_ARRAY_UPPER_BOUND_TYPE (type) == BOUND_CANNOT_BE_DETERMINED)
-	fprintf_filtered (stream, "character*(*)");
+      if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
+	fprintfi_filtered (level, stream, "character*(*)");
       else
 	{
-	  retcode = f77_get_dynamic_upperbound (type, &upper_bound);
-
-	  if (retcode == BOUND_FETCH_ERROR)
-	    fprintf_filtered (stream, "character*???");
-	  else
-	    fprintf_filtered (stream, "character*%d", upper_bound);
+	  upper_bound = f77_get_upperbound (type);
+	  fprintf_filtered (stream, "character*%d", upper_bound);
 	}
       break;
 
+    case TYPE_CODE_STRUCT:
+    case TYPE_CODE_UNION:
+      if (TYPE_CODE (type) == TYPE_CODE_UNION)
+	fprintfi_filtered (level, stream, "Type, C_Union :: ");
+      else
+	fprintfi_filtered (level, stream, "Type ");
+      fputs_filtered (TYPE_TAG_NAME (type), stream);
+      fputs_filtered ("\n", stream);
+      for (index = 0; index < TYPE_NFIELDS (type); index++)
+	{
+	  f_type_print_base (TYPE_FIELD_TYPE (type, index), stream, show,
+			     level + 4);
+	  fputs_filtered (" :: ", stream);
+	  fputs_filtered (TYPE_FIELD_NAME (type, index), stream);
+	  f_type_print_varspec_suffix (TYPE_FIELD_TYPE (type, index),
+				       stream, 0, 0, 0, 0);
+	  fputs_filtered ("\n", stream);
+	} 
+      fprintfi_filtered (level, stream, "End Type ");
+      fputs_filtered (TYPE_TAG_NAME (type), stream);
+      break;
+
+    case TYPE_CODE_MODULE:
+      fprintfi_filtered (level, stream, "module %s", TYPE_TAG_NAME (type));
+      break;
+
     default_case:
     default:
       /* Handle types not explicitly handled by the other cases,
@@ -450,9 +381,9 @@ f_type_print_base (type, stream, show, level)
          the type name is, as recorded in the type itself.  If there
          is no type name, then complain. */
       if (TYPE_NAME (type) != NULL)
-	fputs_filtered (TYPE_NAME (type), stream);
+	fprintfi_filtered (level, stream, "%s", TYPE_NAME (type));
       else
-	error ("Invalid type code (%d) in symbol table.", TYPE_CODE (type));
+	error (_("Invalid type code (%d) in symbol table."), TYPE_CODE (type));
       break;
     }
 }