2008-03-25 Pedro Alves <pedro@codesourcery.com>
[deliverable/binutils-gdb.git] / gdb / f-valprint.c
index 3aaa2a7c7a33cbb2fbc83b5daf6cccef6d726cac..b2e327189b51c41d93e6f06c56ffa0e252a1c561 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, 2008 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.
@@ -10,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,
@@ -19,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"
@@ -65,13 +63,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 =
@@ -95,7 +95,8 @@ f77_get_dynamic_lowerbound (struct type *type, int *lower_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_lower_bound =
@@ -123,13 +124,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 +161,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 =
@@ -274,7 +278,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 +323,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)
@@ -358,7 +362,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 +370,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 +407,7 @@ f_val_print (struct type *type, const bfd_byte *valaddr, int embedded_offset,
            }
 
          if (addressprint && format != 's')
-           deprecated_print_address_numeric (addr, 1, stream);
+           fputs_filtered (paddress (addr), stream);
 
          /* For a pointer to char or unsigned char, also print the string
             pointed to, unless pointer is null.  */
@@ -426,7 +431,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, "@");
-         deprecated_print_address_numeric (addr, 1, stream);
+         fputs_filtered (paddress (addr), stream);
          if (deref_ref)
            fputs_filtered (": ", stream);
        }
@@ -440,15 +445,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 +488,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);
@@ -583,6 +588,22 @@ 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));
     }
@@ -626,10 +647,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() */
@@ -651,7 +669,8 @@ info_common_command (char *comname, int from_tty)
          be any minimal symbols in the middle of a function.
          FIXME:  (Not necessarily true.  What about text labels) */
 
-      struct minimal_symbol *msymbol = lookup_minimal_symbol_by_pc (get_frame_pc (fi));
+      struct minimal_symbol *msymbol = 
+       lookup_minimal_symbol_by_pc (get_frame_pc (fi));
 
       if (msymbol != NULL
          && (SYMBOL_VALUE_ADDRESS (msymbol)
@@ -667,6 +686,8 @@ info_common_command (char *comname, int from_tty)
 
       if (msymbol != NULL)
        funname = DEPRECATED_SYMBOL_NAME (msymbol);
+      else /* Got no 'funname', code below will fail.  */
+       error (_("No function found for frame."));
     }
 
   /* If comname is NULL, we assume the user wishes to see the 
@@ -718,10 +739,7 @@ there_is_a_visible_common_named (char *comname)
   if (comname == NULL)
     error (_("Cannot deal with NULL common name!"));
 
-  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() */
@@ -771,8 +789,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.030076 seconds and 4 git commands to generate.