*** empty log message ***

[binutils.git] / gdb / f-typeprint.c

diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c
index 7a160bc934b08ad72c1e6471c53c3a1c94d9c525..31b96a371f1bf3648fab02aed1ea57d6245e637e 100644 (file)
--- a/gdb/f-typeprint.c
+++ b/gdb/f-typeprint.c
@@ -1,26 +1,30 @@
 /* Support for printing Fortran types for GDB, the GNU debugger.
 /* 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 Free Software Foundation, Inc.
+

    Contributed by Motorola.  Adapted from the C version by Farooq Butt
    ([email protected]).
 
    Contributed by Motorola.  Adapted from the C version by Farooq Butt
    ([email protected]).
 

-This file is part of GDB.
+   This file is part of GDB.

 
 

-This program is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 2 of the License, or
+   (at your option) any later version.

 
 

-This program is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-GNU General Public License for more details.
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.

 
 

-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
+   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., 51 Franklin Street, Fifth Floor,
+   Boston, MA 02110-1301, USA.  */

 
 #include "defs.h"
 
 #include "defs.h"

-#include "obstack.h"
+#include "gdb_obstack.h"

 #include "bfd.h"
 #include "symtab.h"
 #include "gdbtypes.h"
 #include "bfd.h"
 #include "symtab.h"
 #include "gdbtypes.h"


@@ -28,48 +32,42 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
 #include "value.h"
 #include "gdbcore.h"
 #include "target.h"
 #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 "f-lang.h"

-#include "typeprint.h"
-#include "frame.h"  /* ??? */

 
 #include "gdb_string.h"
 #include <errno.h>
 
 
 #include "gdb_string.h"
 #include <errno.h>
 

-#if 0  /* Currently unused */
-static void f_type_print_args PARAMS ((struct type *, FILE *));
+#if 0                          /* Currently unused */
+static void f_type_print_args (struct type *, struct ui_file *);

 #endif
 
 #endif
 

-static void f_type_print_varspec_suffix PARAMS ((struct type *, FILE *,
-                                                int, int, int));
+static void print_equivalent_f77_float_type (int level, struct type *,
+                                            struct ui_file *);

 
 

-void f_type_print_varspec_prefix PARAMS ((struct type *, FILE *, int, int));
+static void f_type_print_varspec_suffix (struct type *, struct ui_file *,
+                                        int, int, int);

 
 

-void f_type_print_base PARAMS ((struct type *, FILE *, int, int));
+void f_type_print_varspec_prefix (struct type *, struct ui_file *,
+                                 int, int);

 
 

+void f_type_print_base (struct type *, struct ui_file *, int, int);

 \f
 \f

+

 /* LEVEL is the depth to indent lines by.  */
 
 void
 /* LEVEL is the depth to indent lines by.  */
 
 void

-f_print_type (type, varstring, stream, show, level)
-     struct type *type;
-     char *varstring;
-     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')
       ||
   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.  */
+  /* 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
       ((show > 0 || TYPE_NAME (type) == 0)
        &&
        (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC


@@ -85,7 +83,7 @@ f_print_type (type, varstring, stream, show, level)
   /* 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] == ')';
+  demangled_args = varstring[strlen (varstring) - 1] == ')';

   f_type_print_varspec_suffix (type, stream, show, 0, demangled_args);
 }
 
   f_type_print_varspec_suffix (type, stream, show, 0, demangled_args);
 }
 


@@ -98,11 +96,8 @@ f_print_type (type, varstring, stream, show, level)
    SHOW is always zero on recursive calls.  */
 
 void
    SHOW is always zero on recursive calls.  */
 
 void

-f_type_print_varspec_prefix (type, stream, show, passed_a_ptr)
-     struct type *type;
-     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;
 {
   if (type == 0)
     return;


@@ -146,61 +141,20 @@ f_type_print_varspec_prefix (type, stream, show, passed_a_ptr)
     case TYPE_CODE_MEMBER:
     case TYPE_CODE_REF:
     case TYPE_CODE_COMPLEX:
     case TYPE_CODE_MEMBER:
     case TYPE_CODE_REF:
     case TYPE_CODE_COMPLEX:

+    case TYPE_CODE_TYPEDEF:

       /* These types need no prefix.  They are listed here so that
       /* These types need no prefix.  They are listed here so that

-        gcc -Wall will reveal any types that haven't been handled.  */
+         gcc -Wall will reveal any types that haven't been handled.  */

       break;
     }
 }
 
       break;
     }
 }
 

-#if 0  /* Currently unused */
-
-static void
-f_type_print_args (type, stream)
-     struct type *type;
-     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
 /* 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;
-     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 upper_bound, lower_bound;
   int lower_bound_was_default = 0;
 {
   int upper_bound, lower_bound;
   int lower_bound_was_default = 0;


@@ -221,61 +175,60 @@ f_type_print_varspec_suffix (type, stream, show, passed_a_ptr, demangled_args)
       arrayprint_recurse_level++;
 
       if (arrayprint_recurse_level == 1)
       arrayprint_recurse_level++;
 
       if (arrayprint_recurse_level == 1)

-       fprintf_filtered(stream,"(");
+       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);
 
 
       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
        f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0);
 

-      retcode = f77_get_dynamic_lowerbound (type,&lower_bound);
+      retcode = f77_get_dynamic_lowerbound (type, &lower_bound);

 
       lower_bound_was_default = 0;
 
       if (retcode == BOUND_FETCH_ERROR)
 
       lower_bound_was_default = 0;
 
       if (retcode == BOUND_FETCH_ERROR)

-       fprintf_filtered (stream,"???");
+       fprintf_filtered (stream, "???");
+      else if (lower_bound == 1)       /* The default */
+       lower_bound_was_default = 1;

       else
       else

-       if (lower_bound == 1) /* The default */
-         lower_bound_was_default = 1;
-       else
-         fprintf_filtered (stream,"%d",lower_bound);
+       fprintf_filtered (stream, "%d", lower_bound);

 
       if (lower_bound_was_default)
        lower_bound_was_default = 0;
       else
 
       if (lower_bound_was_default)
        lower_bound_was_default = 0;
       else

-       fprintf_filtered(stream,":");
+       fprintf_filtered (stream, ":");

 
       /* Make sure that, if we have an assumed size array, we
 
       /* Make sure that, if we have an assumed size array, we

-        print out a warning and print the upperbound as '*' */
+         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_TYPE (type) == BOUND_CANNOT_BE_DETERMINED)

        fprintf_filtered (stream, "*");
        fprintf_filtered (stream, "*");

-       else
-        {
-          retcode = f77_get_dynamic_upperbound(type,&upper_bound);
+      else
+       {
+         retcode = f77_get_dynamic_upperbound (type, &upper_bound);

 
 

-          if (retcode == BOUND_FETCH_ERROR)
-            fprintf_filtered(stream,"???");
-          else
-            fprintf_filtered(stream,"%d",upper_bound);
-        }
+         if (retcode == BOUND_FETCH_ERROR)
+           fprintf_filtered (stream, "???");
+         else
+           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);
       if (arrayprint_recurse_level == 1)
        fprintf_filtered (stream, ")");
       else
 
       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
        f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0);
       if (arrayprint_recurse_level == 1)
        fprintf_filtered (stream, ")");
       else

-       fprintf_filtered(stream,",");
+       fprintf_filtered (stream, ",");

       arrayprint_recurse_level--;
       break;
 
     case TYPE_CODE_PTR:
     case TYPE_CODE_REF:
       f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0);
       arrayprint_recurse_level--;
       break;
 
     case TYPE_CODE_PTR:
     case TYPE_CODE_REF:
       f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0);

-      fprintf_filtered(stream,")");
+      fprintf_filtered (stream, ")");

       break;
 
     case TYPE_CODE_FUNC:
       f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
       break;
 
     case TYPE_CODE_FUNC:
       f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,

-                                passed_a_ptr, 0);
+                                  passed_a_ptr, 0);

       if (passed_a_ptr)
        fprintf_filtered (stream, ")");
 
       if (passed_a_ptr)
        fprintf_filtered (stream, ")");
 


@@ -299,22 +252,22 @@ f_type_print_varspec_suffix (type, stream, show, passed_a_ptr, demangled_args)
     case TYPE_CODE_METHOD:
     case TYPE_CODE_MEMBER:
     case TYPE_CODE_COMPLEX:
     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
       /* These types do not need a suffix.  They are listed so that

-        gcc -Wall will report types that may not have been considered.  */
+         gcc -Wall will report types that may not have been considered.  */

       break;
     }
 }
 
       break;
     }
 }
 

-void
-print_equivalent_f77_float_type (type, stream)
-     struct type *type;
-     FILE *stream;
+static void
+print_equivalent_f77_float_type (int level, struct type *type,
+                                struct ui_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 */
 
 {
   /* 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));
+  fprintfi_filtered (level, stream, "real*%d", TYPE_LENGTH (type));

 }
 
 /* Print the name of the type (or the ultimate pointer target,
 }
 
 /* Print the name of the type (or the ultimate pointer target,


@@ -331,15 +284,14 @@ print_equivalent_f77_float_type (type, stream)
    We increase it for some recursive calls.  */
 
 void
    We increase it for some recursive calls.  */
 
 void

-f_type_print_base (type, stream, show, level)
-     struct type *type;
-     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 retcode;
   int upper_bound;
 

+  int index;
+

   QUIT;
 
   wrap_here ("    ");
   QUIT;
 
   wrap_here ("    ");


@@ -355,7 +307,7 @@ f_type_print_base (type, stream, show, level)
   if ((show <= 0) && (TYPE_NAME (type) != NULL))
     {
       if (TYPE_CODE (type) == TYPE_CODE_FLT)
   if ((show <= 0) && (TYPE_NAME (type) != NULL))
     {
       if (TYPE_CODE (type) == TYPE_CODE_FLT)

-       print_equivalent_f77_float_type (type, stream);
+       print_equivalent_f77_float_type (level, type, stream);

       else
        fputs_filtered (TYPE_NAME (type), stream);
       return;
       else
        fputs_filtered (TYPE_NAME (type), stream);
       return;


@@ -375,31 +327,36 @@ f_type_print_base (type, stream, show, level)
       f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
       break;
 
       f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
       break;
 

-   case TYPE_CODE_PTR:
+    case TYPE_CODE_PTR:

       fprintf_filtered (stream, "PTR TO -> ( ");
       f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
       break;
 
       fprintf_filtered (stream, "PTR TO -> ( ");
       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:
     case TYPE_CODE_VOID:

-      fprintf_filtered (stream, "VOID");
+      fprintfi_filtered (level, stream, "VOID");

       break;
 
     case TYPE_CODE_UNDEF:
       break;
 
     case TYPE_CODE_UNDEF:

-      fprintf_filtered (stream, "struct <unknown>");
+      fprintfi_filtered (level, stream, "struct <unknown>");

       break;
 
     case TYPE_CODE_ERROR:
       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 */
       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" */
       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:
       break;
 
     case TYPE_CODE_INT:


@@ -407,25 +364,25 @@ 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".  */
 
          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:
       else
        goto default_case;
       break;
 
     case TYPE_CODE_COMPLEX:

-      fprintf_filtered (stream, "complex*%d", TYPE_LENGTH (type));
+      fprintfi_filtered (level, stream, "complex*%d", TYPE_LENGTH (type));

       break;
 
     case TYPE_CODE_FLT:
       break;
 
     case TYPE_CODE_FLT:

-      print_equivalent_f77_float_type (type, stream);
+      print_equivalent_f77_float_type (level, 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)
       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*(*)");
+       fprintfi_filtered (level, stream, "character*(*)");

       else
        {
          retcode = f77_get_dynamic_upperbound (type, &upper_bound);
       else
        {
          retcode = f77_get_dynamic_upperbound (type, &upper_bound);


@@ -437,16 +394,31 @@ f_type_print_base (type, stream, show, level)
        }
       break;
 
        }
       break;
 

+    case TYPE_CODE_STRUCT:
+      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_print_type (TYPE_FIELD_TYPE (type, index), "", stream, show, level + 4);
+         fputs_filtered (" :: ", stream);
+         fputs_filtered (TYPE_FIELD_NAME (type, index), stream);
+         fputs_filtered ("\n", stream);
+       } 
+      fprintfi_filtered (level, stream, "End Type ");
+      fputs_filtered (TYPE_TAG_NAME (type), stream);
+      break;
+

     default_case:
     default:
       /* Handle types not explicitly handled by the other cases,
     default_case:
     default:
       /* Handle types not explicitly handled by the other cases,

-        such as fundamental types.  For these, just print whatever
-        the type name is, as recorded in the type itself.  If there
-        is no type name, then complain. */
+         such as fundamental types.  For these, just print whatever
+         the type name is, as recorded in the type itself.  If there
+         is no type name, then complain. */

       if (TYPE_NAME (type) != NULL)
       if (TYPE_NAME (type) != NULL)

-       fputs_filtered (TYPE_NAME (type), stream);
+       fprintfi_filtered (level, stream, "%s", TYPE_NAME (type));

       else
       else

-       error ("Invalid type code (%d) in symbol table.", TYPE_CODE (type));
+       error (_("Invalid type code (%d) in symbol table."), TYPE_CODE (type));

       break;
     }
 }
       break;
     }
 }