2007-05-08 Paul Gilliam <pgilliam@us.ibm.com>
[deliverable/binutils-gdb.git] / gdb / f-valprint.c
index 61966281a932a934b85f6157ff802d95a20c5c11..41a9771611698173a0f185f84863ef0bd7433ce0 100644 (file)
@@ -1,7 +1,7 @@
 /* Support for printing Fortran values for GDB, the GNU debugger.
 
-   Copyright 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2003, 2005 Free
-   Software Foundation, Inc.
+   Copyright (C) 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2003, 2005, 2006,
+   2007 Free Software Foundation, Inc.
 
    Contributed by Motorola.  Adapted from the C definitions by Farooq Butt
    (fmbutt@engage.sps.mot.com), additionally worked over by Stan Shebs.
@@ -20,8 +20,8 @@
 
    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.  */
+   Foundation, Inc., 51 Franklin Street, Fifth Floor,
+   Boston, MA 02110-1301, USA.  */
 
 #include "defs.h"
 #include "gdb_string.h"
@@ -65,13 +65,15 @@ int f77_array_offset_tbl[MAX_FORTRAN_DIMS + 1][2];
 int
 f77_get_dynamic_lowerbound (struct type *type, int *lower_bound)
 {
+  struct frame_info *frame;
   CORE_ADDR current_frame_addr;
   CORE_ADDR ptr_to_lower_bound;
 
   switch (TYPE_ARRAY_LOWER_BOUND_TYPE (type))
     {
     case BOUND_BY_VALUE_ON_STACK:
-      current_frame_addr = get_frame_base (deprecated_selected_frame);
+      frame = deprecated_safe_get_selected_frame ();
+      current_frame_addr = get_frame_base (frame);
       if (current_frame_addr > 0)
        {
          *lower_bound =
@@ -91,11 +93,12 @@ f77_get_dynamic_lowerbound (struct type *type, int *lower_bound)
       break;
 
     case BOUND_CANNOT_BE_DETERMINED:
-      error ("Lower bound may not be '*' in F77");
+      error (_("Lower bound may not be '*' in F77"));
       break;
 
     case BOUND_BY_REF_ON_STACK:
-      current_frame_addr = get_frame_base (deprecated_selected_frame);
+      frame = deprecated_safe_get_selected_frame ();
+      current_frame_addr = get_frame_base (frame);
       if (current_frame_addr > 0)
        {
          ptr_to_lower_bound =
@@ -114,7 +117,7 @@ f77_get_dynamic_lowerbound (struct type *type, int *lower_bound)
     case BOUND_BY_REF_IN_REG:
     case BOUND_BY_VALUE_IN_REG:
     default:
-      error ("??? unhandled dynamic array bound type ???");
+      error (_("??? unhandled dynamic array bound type ???"));
       break;
     }
   return BOUND_FETCH_OK;
@@ -123,13 +126,15 @@ f77_get_dynamic_lowerbound (struct type *type, int *lower_bound)
 int
 f77_get_dynamic_upperbound (struct type *type, int *upper_bound)
 {
+  struct frame_info *frame;
   CORE_ADDR current_frame_addr = 0;
   CORE_ADDR ptr_to_upper_bound;
 
   switch (TYPE_ARRAY_UPPER_BOUND_TYPE (type))
     {
     case BOUND_BY_VALUE_ON_STACK:
-      current_frame_addr = get_frame_base (deprecated_selected_frame);
+      frame = deprecated_safe_get_selected_frame ();
+      current_frame_addr = get_frame_base (frame);
       if (current_frame_addr > 0)
        {
          *upper_bound =
@@ -158,7 +163,8 @@ f77_get_dynamic_upperbound (struct type *type, int *upper_bound)
       break;
 
     case BOUND_BY_REF_ON_STACK:
-      current_frame_addr = get_frame_base (deprecated_selected_frame);
+      frame = deprecated_safe_get_selected_frame ();
+      current_frame_addr = get_frame_base (frame);
       if (current_frame_addr > 0)
        {
          ptr_to_upper_bound =
@@ -177,7 +183,7 @@ f77_get_dynamic_upperbound (struct type *type, int *upper_bound)
     case BOUND_BY_REF_IN_REG:
     case BOUND_BY_VALUE_IN_REG:
     default:
-      error ("??? unhandled dynamic array bound type ???");
+      error (_("??? unhandled dynamic array bound type ???"));
       break;
     }
   return BOUND_FETCH_OK;
@@ -208,11 +214,11 @@ f77_get_dynamic_length_of_aggregate (struct type *type)
   /* Recursion ends here, start setting up lengths.  */
   retcode = f77_get_dynamic_lowerbound (type, &lower_bound);
   if (retcode == BOUND_FETCH_ERROR)
-    error ("Cannot obtain valid array lower bound");
+    error (_("Cannot obtain valid array lower bound"));
 
   retcode = f77_get_dynamic_upperbound (type, &upper_bound);
   if (retcode == BOUND_FETCH_ERROR)
-    error ("Cannot obtain valid array upper bound");
+    error (_("Cannot obtain valid array upper bound"));
 
   /* Patch in a valid length value. */
 
@@ -240,11 +246,11 @@ f77_create_arrayprint_offset_tbl (struct type *type, struct ui_file *stream)
 
       retcode = f77_get_dynamic_upperbound (tmp_type, &upper);
       if (retcode == BOUND_FETCH_ERROR)
-       error ("Cannot obtain dynamic upper bound");
+       error (_("Cannot obtain dynamic upper bound"));
 
       retcode = f77_get_dynamic_lowerbound (tmp_type, &lower);
       if (retcode == BOUND_FETCH_ERROR)
-       error ("Cannot obtain dynamic lower bound");
+       error (_("Cannot obtain dynamic lower bound"));
 
       F77_DIM_SIZE (ndimen) = upper - lower + 1;
 
@@ -274,7 +280,7 @@ f77_create_arrayprint_offset_tbl (struct type *type, struct ui_file *stream)
 
 static void
 f77_print_array_1 (int nss, int ndimensions, struct type *type,
-                  const bfd_byte *valaddr, CORE_ADDR address,
+                  const gdb_byte *valaddr, CORE_ADDR address,
                   struct ui_file *stream, int format,
                   int deref_ref, int recurse, enum val_prettyprint pretty,
                   int *elts)
@@ -319,7 +325,7 @@ f77_print_array_1 (int nss, int ndimensions, struct type *type,
    stuff and then immediately call f77_print_array_1() */
 
 static void
-f77_print_array (struct type *type, const bfd_byte *valaddr,
+f77_print_array (struct type *type, const gdb_byte *valaddr,
                 CORE_ADDR address, struct ui_file *stream,
                 int format, int deref_ref, int recurse,
                 enum val_prettyprint pretty)
@@ -330,7 +336,7 @@ f77_print_array (struct type *type, const bfd_byte *valaddr,
   ndimensions = calc_f77_array_dims (type);
 
   if (ndimensions > MAX_FORTRAN_DIMS || ndimensions < 0)
-    error ("Type node corrupt! F77 arrays cannot have %d subscripts (%d Max)",
+    error (_("Type node corrupt! F77 arrays cannot have %d subscripts (%d Max)"),
           ndimensions, MAX_FORTRAN_DIMS);
 
   /* Since F77 arrays are stored column-major, we set up an 
@@ -358,7 +364,7 @@ f77_print_array (struct type *type, const bfd_byte *valaddr,
    The PRETTY parameter controls prettyprinting.  */
 
 int
-f_val_print (struct type *type, const bfd_byte *valaddr, int embedded_offset,
+f_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset,
             CORE_ADDR address, struct ui_file *stream, int format,
             int deref_ref, int recurse, enum val_prettyprint pretty)
 {
@@ -366,6 +372,7 @@ f_val_print (struct type *type, const bfd_byte *valaddr, int embedded_offset,
   struct type *elttype;
   LONGEST val;
   CORE_ADDR addr;
+  int index;
 
   CHECK_TYPEDEF (type);
   switch (TYPE_CODE (type))
@@ -402,7 +409,7 @@ f_val_print (struct type *type, const bfd_byte *valaddr, int embedded_offset,
            }
 
          if (addressprint && format != 's')
-           print_address_numeric (addr, 1, stream);
+           deprecated_print_address_numeric (addr, 1, stream);
 
          /* For a pointer to char or unsigned char, also print the string
             pointed to, unless pointer is null.  */
@@ -426,7 +433,7 @@ f_val_print (struct type *type, const bfd_byte *valaddr, int embedded_offset,
          CORE_ADDR addr
            = extract_typed_address (valaddr + embedded_offset, type);
          fprintf_filtered (stream, "@");
-         print_address_numeric (addr, 1, stream);
+         deprecated_print_address_numeric (addr, 1, stream);
          if (deref_ref)
            fputs_filtered (": ", stream);
        }
@@ -440,15 +447,8 @@ f_val_print (struct type *type, const bfd_byte *valaddr, int embedded_offset,
              (TYPE_TARGET_TYPE (type),
               unpack_pointer (lookup_pointer_type (builtin_type_void),
                               valaddr + embedded_offset));
-             val_print (value_type (deref_val),
-                        value_contents (deref_val),
-                        0,
-                        VALUE_ADDRESS (deref_val),
-                        stream,
-                        format,
-                        deref_ref,
-                        recurse,
-                        pretty);
+             common_val_print (deref_val, stream, format, deref_ref, recurse,
+                               pretty);
            }
          else
            fputs_filtered ("???", stream);
@@ -490,6 +490,13 @@ f_val_print (struct type *type, const bfd_byte *valaddr, int embedded_offset,
        }
       break;
 
+    case TYPE_CODE_FLAGS:
+      if (format)
+         print_scalar_formatted (valaddr, type, format, 0, stream);
+      else
+       val_print_type_code_flags (type, valaddr, stream);
+      break;
+
     case TYPE_CODE_FLT:
       if (format)
        print_scalar_formatted (valaddr, type, format, 0, stream);
@@ -532,7 +539,7 @@ f_val_print (struct type *type, const bfd_byte *valaddr, int embedded_offset,
              break;
 
            default:
-             error ("Logicals of length %d bytes not supported",
+             error (_("Logicals of length %d bytes not supported"),
                     TYPE_LENGTH (type));
 
            }
@@ -567,7 +574,7 @@ f_val_print (struct type *type, const bfd_byte *valaddr, int embedded_offset,
          type = builtin_type_f_real_s16;
          break;
        default:
-         error ("Cannot print out complex*%d variables", TYPE_LENGTH (type));
+         error (_("Cannot print out complex*%d variables"), TYPE_LENGTH (type));
        }
       fputs_filtered ("(", stream);
       print_floating (valaddr, type, stream);
@@ -583,8 +590,24 @@ f_val_print (struct type *type, const bfd_byte *valaddr, int embedded_offset,
       fprintf_filtered (stream, "<incomplete type>");
       break;
 
+    case TYPE_CODE_STRUCT:
+      /* Starting from the Fortran 90 standard, Fortran supports derived
+         types.  */
+      fprintf_filtered (stream, "{ ");
+      for (index = 0; index < TYPE_NFIELDS (type); index++)
+        {
+          int offset = TYPE_FIELD_BITPOS (type, index) / 8;
+          f_val_print (TYPE_FIELD_TYPE (type, index), valaddr + offset,
+                       embedded_offset, address, stream,
+                       format, deref_ref, recurse, pretty);
+          if (index != TYPE_NFIELDS (type) - 1)
+            fputs_filtered (", ", stream);
+        }
+      fprintf_filtered (stream, "}");
+      break;     
+
     default:
-      error ("Invalid F77 type code %d in symbol table.", TYPE_CODE (type));
+      error (_("Invalid F77 type code %d in symbol table."), TYPE_CODE (type));
     }
   gdb_flush (stream);
   return 0;
@@ -597,7 +620,7 @@ list_all_visible_commons (char *funname)
 
   tmp = head_common_list;
 
-  printf_filtered ("All COMMON blocks visible at this level:\n\n");
+  printf_filtered (_("All COMMON blocks visible at this level:\n\n"));
 
   while (tmp != NULL)
     {
@@ -626,10 +649,7 @@ info_common_command (char *comname, int from_tty)
      first make sure that it is visible and if so, let 
      us display its contents */
 
-  fi = deprecated_selected_frame;
-
-  if (fi == NULL)
-    error ("No frame selected");
+  fi = get_selected_frame (_("No frame selected"));
 
   /* The following is generally ripped off from stack.c's routine 
      print_frame_info() */
@@ -683,9 +703,9 @@ info_common_command (char *comname, int from_tty)
   if (the_common)
     {
       if (strcmp (comname, BLANK_COMMON_NAME_LOCAL) == 0)
-       printf_filtered ("Contents of blank COMMON block:\n");
+       printf_filtered (_("Contents of blank COMMON block:\n"));
       else
-       printf_filtered ("Contents of F77 COMMON block '%s':\n", comname);
+       printf_filtered (_("Contents of F77 COMMON block '%s':\n"), comname);
 
       printf_filtered ("\n");
       entry = the_common->entries;
@@ -699,7 +719,7 @@ info_common_command (char *comname, int from_tty)
        }
     }
   else
-    printf_filtered ("Cannot locate the common block %s in function '%s'\n",
+    printf_filtered (_("Cannot locate the common block %s in function '%s'\n"),
                     comname, funname);
 }
 
@@ -716,12 +736,9 @@ there_is_a_visible_common_named (char *comname)
   struct symbol *func;
 
   if (comname == NULL)
-    error ("Cannot deal with NULL common name!");
-
-  fi = deprecated_selected_frame;
+    error (_("Cannot deal with NULL common name!"));
 
-  if (fi == NULL)
-    error ("No frame selected");
+  fi = get_selected_frame (_("No frame selected"));
 
   /* The following is generally ripped off from stack.c's routine 
      print_frame_info() */
@@ -771,8 +788,8 @@ void
 _initialize_f_valprint (void)
 {
   add_info ("common", info_common_command,
-           "Print out the values contained in a Fortran COMMON block.");
+           _("Print out the values contained in a Fortran COMMON block."));
   if (xdb_commands)
     add_com ("lc", class_info, info_common_command,
-            "Print out the values contained in a Fortran COMMON block.");
+            _("Print out the values contained in a Fortran COMMON block."));
 }
This page took 0.031052 seconds and 4 git commands to generate.