gdb/f-valprint.c

   1 /* Support for printing Fortran values for GDB, the GNU debugger.
   2
   3    Copyright (C) 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2003, 2005, 2006,
   4    2007, 2008 Free Software Foundation, Inc.
   5
   6    Contributed by Motorola.  Adapted from the C definitions by Farooq Butt
   7    (fmbutt@engage.sps.mot.com), additionally worked over by Stan Shebs.
   8
   9    This file is part of GDB.
  10
  11    This program is free software; you can redistribute it and/or modify
  12    it under the terms of the GNU General Public License as published by
  13    the Free Software Foundation; either version 3 of the License, or
  14    (at your option) any later version.
  15
  16    This program is distributed in the hope that it will be useful,
  17    but WITHOUT ANY WARRANTY; without even the implied warranty of
  18    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19    GNU General Public License for more details.
  20
  21    You should have received a copy of the GNU General Public License
  22    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
  23
  24 #include "defs.h"
  25 #include "gdb_string.h"
  26 #include "symtab.h"
  27 #include "gdbtypes.h"
  28 #include "expression.h"
  29 #include "value.h"
  30 #include "valprint.h"
  31 #include "language.h"
  32 #include "f-lang.h"
  33 #include "frame.h"
  34 #include "gdbcore.h"
  35 #include "command.h"
  36 #include "block.h"
  37
  38 #if 0
  39 static int there_is_a_visible_common_named (char *);
  40 #endif
  41
  42 extern void _initialize_f_valprint (void);
  43 static void info_common_command (char *, int);
  44 static void list_all_visible_commons (char *);
  45 static void f77_create_arrayprint_offset_tbl (struct type *,
  46                                               struct ui_file *);
  47 static void f77_get_dynamic_length_of_aggregate (struct type *);
  48
  49 int f77_array_offset_tbl[MAX_FORTRAN_DIMS + 1][2];
  50
  51 /* Array which holds offsets to be applied to get a row's elements
  52    for a given array. Array also holds the size of each subarray.  */
  53
  54 /* The following macro gives us the size of the nth dimension, Where
  55    n is 1 based. */
  56
  57 #define F77_DIM_SIZE(n) (f77_array_offset_tbl[n][1])
  58
  59 /* The following gives us the offset for row n where n is 1-based. */
  60
  61 #define F77_DIM_OFFSET(n) (f77_array_offset_tbl[n][0])
  62
  63 int
  64 f77_get_dynamic_lowerbound (struct type *type, int *lower_bound)
  65 {
  66   struct frame_info *frame;
  67   CORE_ADDR current_frame_addr;
  68   CORE_ADDR ptr_to_lower_bound;
  69
  70   switch (TYPE_ARRAY_LOWER_BOUND_TYPE (type))
  71     {
  72     case BOUND_BY_VALUE_ON_STACK:
  73       frame = deprecated_safe_get_selected_frame ();
  74       current_frame_addr = get_frame_base (frame);
  75       if (current_frame_addr > 0)
  76         {
  77           *lower_bound =
  78             read_memory_integer (current_frame_addr +
  79                                  TYPE_ARRAY_LOWER_BOUND_VALUE (type),
  80                                  4);
  81         }
  82       else
  83         {
  84           *lower_bound = DEFAULT_LOWER_BOUND;
  85           return BOUND_FETCH_ERROR;
  86         }
  87       break;
  88
  89     case BOUND_SIMPLE:
  90       *lower_bound = TYPE_ARRAY_LOWER_BOUND_VALUE (type);
  91       break;
  92
  93     case BOUND_CANNOT_BE_DETERMINED:
  94       error (_("Lower bound may not be '*' in F77"));
  95       break;
  96
  97     case BOUND_BY_REF_ON_STACK:
  98       frame = deprecated_safe_get_selected_frame ();
  99       current_frame_addr = get_frame_base (frame);
 100       if (current_frame_addr > 0)
 101         {
 102           ptr_to_lower_bound =
 103             read_memory_typed_address (current_frame_addr +
 104                                        TYPE_ARRAY_LOWER_BOUND_VALUE (type),
 105                                        builtin_type_void_data_ptr);
 106           *lower_bound = read_memory_integer (ptr_to_lower_bound, 4);
 107         }
 108       else
 109         {
 110           *lower_bound = DEFAULT_LOWER_BOUND;
 111           return BOUND_FETCH_ERROR;
 112         }
 113       break;
 114
 115     case BOUND_BY_REF_IN_REG:
 116     case BOUND_BY_VALUE_IN_REG:
 117     default:
 118       error (_("??? unhandled dynamic array bound type ???"));
 119       break;
 120     }
 121   return BOUND_FETCH_OK;
 122 }
 123
 124 int
 125 f77_get_dynamic_upperbound (struct type *type, int *upper_bound)
 126 {
 127   struct frame_info *frame;
 128   CORE_ADDR current_frame_addr = 0;
 129   CORE_ADDR ptr_to_upper_bound;
 130
 131   switch (TYPE_ARRAY_UPPER_BOUND_TYPE (type))
 132     {
 133     case BOUND_BY_VALUE_ON_STACK:
 134       frame = deprecated_safe_get_selected_frame ();
 135       current_frame_addr = get_frame_base (frame);
 136       if (current_frame_addr > 0)
 137         {
 138           *upper_bound =
 139             read_memory_integer (current_frame_addr +
 140                                  TYPE_ARRAY_UPPER_BOUND_VALUE (type),
 141                                  4);
 142         }
 143       else
 144         {
 145           *upper_bound = DEFAULT_UPPER_BOUND;
 146           return BOUND_FETCH_ERROR;
 147         }
 148       break;
 149
 150     case BOUND_SIMPLE:
 151       *upper_bound = TYPE_ARRAY_UPPER_BOUND_VALUE (type);
 152       break;
 153
 154     case BOUND_CANNOT_BE_DETERMINED:
 155       /* we have an assumed size array on our hands. Assume that
 156          upper_bound == lower_bound so that we show at least
 157          1 element.If the user wants to see more elements, let
 158          him manually ask for 'em and we'll subscript the
 159          array and show him */
 160       f77_get_dynamic_lowerbound (type, upper_bound);
 161       break;
 162
 163     case BOUND_BY_REF_ON_STACK:
 164       frame = deprecated_safe_get_selected_frame ();
 165       current_frame_addr = get_frame_base (frame);
 166       if (current_frame_addr > 0)
 167         {
 168           ptr_to_upper_bound =
 169             read_memory_typed_address (current_frame_addr +
 170                                        TYPE_ARRAY_UPPER_BOUND_VALUE (type),
 171                                        builtin_type_void_data_ptr);
 172           *upper_bound = read_memory_integer (ptr_to_upper_bound, 4);
 173         }
 174       else
 175         {
 176           *upper_bound = DEFAULT_UPPER_BOUND;
 177           return BOUND_FETCH_ERROR;
 178         }
 179       break;
 180
 181     case BOUND_BY_REF_IN_REG:
 182     case BOUND_BY_VALUE_IN_REG:
 183     default:
 184       error (_("??? unhandled dynamic array bound type ???"));
 185       break;
 186     }
 187   return BOUND_FETCH_OK;
 188 }
 189
 190 /* Obtain F77 adjustable array dimensions */
 191
 192 static void
 193 f77_get_dynamic_length_of_aggregate (struct type *type)
 194 {
 195   int upper_bound = -1;
 196   int lower_bound = 1;
 197   int retcode;
 198
 199   /* Recursively go all the way down into a possibly multi-dimensional
 200      F77 array and get the bounds.  For simple arrays, this is pretty
 201      easy but when the bounds are dynamic, we must be very careful
 202      to add up all the lengths correctly.  Not doing this right
 203      will lead to horrendous-looking arrays in parameter lists.
 204
 205      This function also works for strings which behave very
 206      similarly to arrays.  */
 207
 208   if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY
 209       || TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_STRING)
 210     f77_get_dynamic_length_of_aggregate (TYPE_TARGET_TYPE (type));
 211
 212   /* Recursion ends here, start setting up lengths.  */
 213   retcode = f77_get_dynamic_lowerbound (type, &lower_bound);
 214   if (retcode == BOUND_FETCH_ERROR)
 215     error (_("Cannot obtain valid array lower bound"));
 216
 217   retcode = f77_get_dynamic_upperbound (type, &upper_bound);
 218   if (retcode == BOUND_FETCH_ERROR)
 219     error (_("Cannot obtain valid array upper bound"));
 220
 221   /* Patch in a valid length value. */
 222
 223   TYPE_LENGTH (type) =
 224     (upper_bound - lower_bound + 1) * TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type)));
 225 }
 226
 227 /* Function that sets up the array offset,size table for the array
 228    type "type".  */
 229
 230 static void
 231 f77_create_arrayprint_offset_tbl (struct type *type, struct ui_file *stream)
 232 {
 233   struct type *tmp_type;
 234   int eltlen;
 235   int ndimen = 1;
 236   int upper, lower, retcode;
 237
 238   tmp_type = type;
 239
 240   while ((TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY))
 241     {
 242       if (TYPE_ARRAY_UPPER_BOUND_TYPE (tmp_type) == BOUND_CANNOT_BE_DETERMINED)
 243         fprintf_filtered (stream, "<assumed size array> ");
 244
 245       retcode = f77_get_dynamic_upperbound (tmp_type, &upper);
 246       if (retcode == BOUND_FETCH_ERROR)
 247         error (_("Cannot obtain dynamic upper bound"));
 248
 249       retcode = f77_get_dynamic_lowerbound (tmp_type, &lower);
 250       if (retcode == BOUND_FETCH_ERROR)
 251         error (_("Cannot obtain dynamic lower bound"));
 252
 253       F77_DIM_SIZE (ndimen) = upper - lower + 1;
 254
 255       tmp_type = TYPE_TARGET_TYPE (tmp_type);
 256       ndimen++;
 257     }
 258
 259   /* Now we multiply eltlen by all the offsets, so that later we
 260      can print out array elements correctly.  Up till now we
 261      know an offset to apply to get the item but we also
 262      have to know how much to add to get to the next item */
 263
 264   ndimen--;
 265   eltlen = TYPE_LENGTH (tmp_type);
 266   F77_DIM_OFFSET (ndimen) = eltlen;
 267   while (--ndimen > 0)
 268     {
 269       eltlen *= F77_DIM_SIZE (ndimen + 1);
 270       F77_DIM_OFFSET (ndimen) = eltlen;
 271     }
 272 }
 273
 274
 275
 276 /* Actual function which prints out F77 arrays, Valaddr == address in
 277    the superior.  Address == the address in the inferior.  */
 278
 279 static void
 280 f77_print_array_1 (int nss, int ndimensions, struct type *type,
 281                    const gdb_byte *valaddr, CORE_ADDR address,
 282                    struct ui_file *stream, int format,
 283                    int deref_ref, int recurse, enum val_prettyprint pretty,
 284                    int *elts)
 285 {
 286   int i;
 287
 288   if (nss != ndimensions)
 289     {
 290       for (i = 0; (i < F77_DIM_SIZE (nss) && (*elts) < print_max); i++)
 291         {
 292           fprintf_filtered (stream, "( ");
 293           f77_print_array_1 (nss + 1, ndimensions, TYPE_TARGET_TYPE (type),
 294                              valaddr + i * F77_DIM_OFFSET (nss),
 295                              address + i * F77_DIM_OFFSET (nss),
 296                              stream, format, deref_ref, recurse, pretty, elts);
 297           fprintf_filtered (stream, ") ");
 298         }
 299       if (*elts >= print_max && i < F77_DIM_SIZE (nss))
 300         fprintf_filtered (stream, "...");
 301     }
 302   else
 303     {
 304       for (i = 0; i < F77_DIM_SIZE (nss) && (*elts) < print_max;
 305            i++, (*elts)++)
 306         {
 307           val_print (TYPE_TARGET_TYPE (type),
 308                      valaddr + i * F77_DIM_OFFSET (ndimensions),
 309                      0,
 310                      address + i * F77_DIM_OFFSET (ndimensions),
 311                      stream, format, deref_ref, recurse, pretty);
 312
 313           if (i != (F77_DIM_SIZE (nss) - 1))
 314             fprintf_filtered (stream, ", ");
 315
 316           if ((*elts == print_max - 1) && (i != (F77_DIM_SIZE (nss) - 1)))
 317             fprintf_filtered (stream, "...");
 318         }
 319     }
 320 }
 321
 322 /* This function gets called to print an F77 array, we set up some
 323    stuff and then immediately call f77_print_array_1() */
 324
 325 static void
 326 f77_print_array (struct type *type, const gdb_byte *valaddr,
 327                  CORE_ADDR address, struct ui_file *stream,
 328                  int format, int deref_ref, int recurse,
 329                  enum val_prettyprint pretty)
 330 {
 331   int ndimensions;
 332   int elts = 0;
 333
 334   ndimensions = calc_f77_array_dims (type);
 335
 336   if (ndimensions > MAX_FORTRAN_DIMS || ndimensions < 0)
 337     error (_("Type node corrupt! F77 arrays cannot have %d subscripts (%d Max)"),
 338            ndimensions, MAX_FORTRAN_DIMS);
 339
 340   /* Since F77 arrays are stored column-major, we set up an
 341      offset table to get at the various row's elements. The
 342      offset table contains entries for both offset and subarray size. */
 343
 344   f77_create_arrayprint_offset_tbl (type, stream);
 345
 346   f77_print_array_1 (1, ndimensions, type, valaddr, address, stream, format,
 347                      deref_ref, recurse, pretty, &elts);
 348 }
 349 \f
 350
 351 /* Print data of type TYPE located at VALADDR (within GDB), which came from
 352    the inferior at address ADDRESS, onto stdio stream STREAM according to
 353    FORMAT (a letter or 0 for natural format).  The data at VALADDR is in
 354    target byte order.
 355
 356    If the data are a string pointer, returns the number of string characters
 357    printed.
 358
 359    If DEREF_REF is nonzero, then dereference references, otherwise just print
 360    them like pointers.
 361
 362    The PRETTY parameter controls prettyprinting.  */
 363
 364 int
 365 f_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset,
 366              CORE_ADDR address, struct ui_file *stream, int format,
 367              int deref_ref, int recurse, enum val_prettyprint pretty)
 368 {
 369   unsigned int i = 0;   /* Number of characters printed */
 370   struct type *elttype;
 371   LONGEST val;
 372   CORE_ADDR addr;
 373   int index;
 374
 375   CHECK_TYPEDEF (type);
 376   switch (TYPE_CODE (type))
 377     {
 378     case TYPE_CODE_STRING:
 379       f77_get_dynamic_length_of_aggregate (type);
 380       LA_PRINT_STRING (stream, valaddr, TYPE_LENGTH (type), 1, 0);
 381       break;
 382
 383     case TYPE_CODE_ARRAY:
 384       fprintf_filtered (stream, "(");
 385       f77_print_array (type, valaddr, address, stream, format,
 386                        deref_ref, recurse, pretty);
 387       fprintf_filtered (stream, ")");
 388       break;
 389
 390     case TYPE_CODE_PTR:
 391       if (format && format != 's')
 392         {
 393           print_scalar_formatted (valaddr, type, format, 0, stream);
 394           break;
 395         }
 396       else
 397         {
 398           addr = unpack_pointer (type, valaddr);
 399           elttype = check_typedef (TYPE_TARGET_TYPE (type));
 400
 401           if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
 402             {
 403               /* Try to print what function it points to.  */
 404               print_address_demangle (addr, stream, demangle);
 405               /* Return value is irrelevant except for string pointers.  */
 406               return 0;
 407             }
 408
 409           if (addressprint && format != 's')
 410             fputs_filtered (paddress (addr), stream);
 411
 412           /* For a pointer to char or unsigned char, also print the string
 413              pointed to, unless pointer is null.  */
 414           if (TYPE_LENGTH (elttype) == 1
 415               && TYPE_CODE (elttype) == TYPE_CODE_INT
 416               && (format == 0 || format == 's')
 417               && addr != 0)
 418             i = val_print_string (addr, -1, TYPE_LENGTH (elttype), stream);
 419
 420           /* Return number of characters printed, including the terminating
 421              '\0' if we reached the end.  val_print_string takes care including
 422              the terminating '\0' if necessary.  */
 423           return i;
 424         }
 425       break;
 426
 427     case TYPE_CODE_REF:
 428       elttype = check_typedef (TYPE_TARGET_TYPE (type));
 429       if (addressprint)
 430         {
 431           CORE_ADDR addr
 432             = extract_typed_address (valaddr + embedded_offset, type);
 433           fprintf_filtered (stream, "@");
 434           fputs_filtered (paddress (addr), stream);
 435           if (deref_ref)
 436             fputs_filtered (": ", stream);
 437         }
 438       /* De-reference the reference.  */
 439       if (deref_ref)
 440         {
 441           if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
 442             {
 443               struct value *deref_val =
 444               value_at
 445               (TYPE_TARGET_TYPE (type),
 446                unpack_pointer (lookup_pointer_type (builtin_type_void),
 447                                valaddr + embedded_offset));
 448               common_val_print (deref_val, stream, format, deref_ref, recurse,
 449                                 pretty);
 450             }
 451           else
 452             fputs_filtered ("???", stream);
 453         }
 454       break;
 455
 456     case TYPE_CODE_FUNC:
 457       if (format)
 458         {
 459           print_scalar_formatted (valaddr, type, format, 0, stream);
 460           break;
 461         }
 462       /* FIXME, we should consider, at least for ANSI C language, eliminating
 463          the distinction made between FUNCs and POINTERs to FUNCs.  */
 464       fprintf_filtered (stream, "{");
 465       type_print (type, "", stream, -1);
 466       fprintf_filtered (stream, "} ");
 467       /* Try to print what function it points to, and its address.  */
 468       print_address_demangle (address, stream, demangle);
 469       break;
 470
 471     case TYPE_CODE_INT:
 472       format = format ? format : output_format;
 473       if (format)
 474         print_scalar_formatted (valaddr, type, format, 0, stream);
 475       else
 476         {
 477           val_print_type_code_int (type, valaddr, stream);
 478           /* C and C++ has no single byte int type, char is used instead.
 479              Since we don't know whether the value is really intended to
 480              be used as an integer or a character, print the character
 481              equivalent as well. */
 482           if (TYPE_LENGTH (type) == 1)
 483             {
 484               fputs_filtered (" ", stream);
 485               LA_PRINT_CHAR ((unsigned char) unpack_long (type, valaddr),
 486                              stream);
 487             }
 488         }
 489       break;
 490
 491     case TYPE_CODE_FLAGS:
 492       if (format)
 493           print_scalar_formatted (valaddr, type, format, 0, stream);
 494       else
 495         val_print_type_code_flags (type, valaddr, stream);
 496       break;
 497
 498     case TYPE_CODE_FLT:
 499       if (format)
 500         print_scalar_formatted (valaddr, type, format, 0, stream);
 501       else
 502         print_floating (valaddr, type, stream);
 503       break;
 504
 505     case TYPE_CODE_VOID:
 506       fprintf_filtered (stream, "VOID");
 507       break;
 508
 509     case TYPE_CODE_ERROR:
 510       fprintf_filtered (stream, "<error type>");
 511       break;
 512
 513     case TYPE_CODE_RANGE:
 514       /* FIXME, we should not ever have to print one of these yet.  */
 515       fprintf_filtered (stream, "<range type>");
 516       break;
 517
 518     case TYPE_CODE_BOOL:
 519       format = format ? format : output_format;
 520       if (format)
 521         print_scalar_formatted (valaddr, type, format, 0, stream);
 522       else
 523         {
 524           val = 0;
 525           switch (TYPE_LENGTH (type))
 526             {
 527             case 1:
 528               val = unpack_long (builtin_type_f_logical_s1, valaddr);
 529               break;
 530
 531             case 2:
 532               val = unpack_long (builtin_type_f_logical_s2, valaddr);
 533               break;
 534
 535             case 4:
 536               val = unpack_long (builtin_type_f_logical, valaddr);
 537               break;
 538
 539             default:
 540               error (_("Logicals of length %d bytes not supported"),
 541                      TYPE_LENGTH (type));
 542
 543             }
 544
 545           if (val == 0)
 546             fprintf_filtered (stream, ".FALSE.");
 547           else if (val == 1)
 548             fprintf_filtered (stream, ".TRUE.");
 549           else
 550             /* Not a legitimate logical type, print as an integer.  */
 551             {
 552               /* Bash the type code temporarily.  */
 553               TYPE_CODE (type) = TYPE_CODE_INT;
 554               f_val_print (type, valaddr, 0, address, stream, format,
 555                            deref_ref, recurse, pretty);
 556               /* Restore the type code so later uses work as intended. */
 557               TYPE_CODE (type) = TYPE_CODE_BOOL;
 558             }
 559         }
 560       break;
 561
 562     case TYPE_CODE_COMPLEX:
 563       switch (TYPE_LENGTH (type))
 564         {
 565         case 8:
 566           type = builtin_type_f_real;
 567           break;
 568         case 16:
 569           type = builtin_type_f_real_s8;
 570           break;
 571         case 32:
 572           type = builtin_type_f_real_s16;
 573           break;
 574         default:
 575           error (_("Cannot print out complex*%d variables"), TYPE_LENGTH (type));
 576         }
 577       fputs_filtered ("(", stream);
 578       print_floating (valaddr, type, stream);
 579       fputs_filtered (",", stream);
 580       print_floating (valaddr + TYPE_LENGTH (type), type, stream);
 581       fputs_filtered (")", stream);
 582       break;
 583
 584     case TYPE_CODE_UNDEF:
 585       /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
 586          dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
 587          and no complete type for struct foo in that file.  */
 588       fprintf_filtered (stream, "<incomplete type>");
 589       break;
 590
 591     case TYPE_CODE_STRUCT:
 592     case TYPE_CODE_UNION:
 593       /* Starting from the Fortran 90 standard, Fortran supports derived
 594          types.  */
 595       fprintf_filtered (stream, "( ");
 596       for (index = 0; index < TYPE_NFIELDS (type); index++)
 597         {
 598           int offset = TYPE_FIELD_BITPOS (type, index) / 8;
 599           f_val_print (TYPE_FIELD_TYPE (type, index), valaddr + offset,
 600                        embedded_offset, address, stream,
 601                        format, deref_ref, recurse, pretty);
 602           if (index != TYPE_NFIELDS (type) - 1)
 603             fputs_filtered (", ", stream);
 604         }
 605       fprintf_filtered (stream, " )");
 606       break;
 607
 608     default:
 609       error (_("Invalid F77 type code %d in symbol table."), TYPE_CODE (type));
 610     }
 611   gdb_flush (stream);
 612   return 0;
 613 }
 614
 615 static void
 616 list_all_visible_commons (char *funname)
 617 {
 618   SAVED_F77_COMMON_PTR tmp;
 619
 620   tmp = head_common_list;
 621
 622   printf_filtered (_("All COMMON blocks visible at this level:\n\n"));
 623
 624   while (tmp != NULL)
 625     {
 626       if (strcmp (tmp->owning_function, funname) == 0)
 627         printf_filtered ("%s\n", tmp->name);
 628
 629       tmp = tmp->next;
 630     }
 631 }
 632
 633 /* This function is used to print out the values in a given COMMON
 634    block. It will always use the most local common block of the
 635    given name */
 636
 637 static void
 638 info_common_command (char *comname, int from_tty)
 639 {
 640   SAVED_F77_COMMON_PTR the_common;
 641   COMMON_ENTRY_PTR entry;
 642   struct frame_info *fi;
 643   char *funname = 0;
 644   struct symbol *func;
 645
 646   /* We have been told to display the contents of F77 COMMON
 647      block supposedly visible in this function.  Let us
 648      first make sure that it is visible and if so, let
 649      us display its contents */
 650
 651   fi = get_selected_frame (_("No frame selected"));
 652
 653   /* The following is generally ripped off from stack.c's routine
 654      print_frame_info() */
 655
 656   func = find_pc_function (get_frame_pc (fi));
 657   if (func)
 658     {
 659       /* In certain pathological cases, the symtabs give the wrong
 660          function (when we are in the first function in a file which
 661          is compiled without debugging symbols, the previous function
 662          is compiled with debugging symbols, and the "foo.o" symbol
 663          that is supposed to tell us where the file with debugging symbols
 664          ends has been truncated by ar because it is longer than 15
 665          characters).
 666
 667          So look in the minimal symbol tables as well, and if it comes
 668          up with a larger address for the function use that instead.
 669          I don't think this can ever cause any problems; there shouldn't
 670          be any minimal symbols in the middle of a function.
 671          FIXME:  (Not necessarily true.  What about text labels) */
 672
 673       struct minimal_symbol *msymbol =
 674         lookup_minimal_symbol_by_pc (get_frame_pc (fi));
 675
 676       if (msymbol != NULL
 677           && (SYMBOL_VALUE_ADDRESS (msymbol)
 678               > BLOCK_START (SYMBOL_BLOCK_VALUE (func))))
 679         funname = DEPRECATED_SYMBOL_NAME (msymbol);
 680       else
 681         funname = DEPRECATED_SYMBOL_NAME (func);
 682     }
 683   else
 684     {
 685       struct minimal_symbol *msymbol =
 686       lookup_minimal_symbol_by_pc (get_frame_pc (fi));
 687
 688       if (msymbol != NULL)
 689         funname = DEPRECATED_SYMBOL_NAME (msymbol);
 690       else /* Got no 'funname', code below will fail.  */
 691         error (_("No function found for frame."));
 692     }
 693
 694   /* If comname is NULL, we assume the user wishes to see the
 695      which COMMON blocks are visible here and then return */
 696
 697   if (comname == 0)
 698     {
 699       list_all_visible_commons (funname);
 700       return;
 701     }
 702
 703   the_common = find_common_for_function (comname, funname);
 704
 705   if (the_common)
 706     {
 707       if (strcmp (comname, BLANK_COMMON_NAME_LOCAL) == 0)
 708         printf_filtered (_("Contents of blank COMMON block:\n"));
 709       else
 710         printf_filtered (_("Contents of F77 COMMON block '%s':\n"), comname);
 711
 712       printf_filtered ("\n");
 713       entry = the_common->entries;
 714
 715       while (entry != NULL)
 716         {
 717           printf_filtered ("%s = ", DEPRECATED_SYMBOL_NAME (entry->symbol));
 718           print_variable_value (entry->symbol, fi, gdb_stdout);
 719           printf_filtered ("\n");
 720           entry = entry->next;
 721         }
 722     }
 723   else
 724     printf_filtered (_("Cannot locate the common block %s in function '%s'\n"),
 725                      comname, funname);
 726 }
 727
 728 /* This function is used to determine whether there is a
 729    F77 common block visible at the current scope called 'comname'. */
 730
 731 #if 0
 732 static int
 733 there_is_a_visible_common_named (char *comname)
 734 {
 735   SAVED_F77_COMMON_PTR the_common;
 736   struct frame_info *fi;
 737   char *funname = 0;
 738   struct symbol *func;
 739
 740   if (comname == NULL)
 741     error (_("Cannot deal with NULL common name!"));
 742
 743   fi = get_selected_frame (_("No frame selected"));
 744
 745   /* The following is generally ripped off from stack.c's routine
 746      print_frame_info() */
 747
 748   func = find_pc_function (fi->pc);
 749   if (func)
 750     {
 751       /* In certain pathological cases, the symtabs give the wrong
 752          function (when we are in the first function in a file which
 753          is compiled without debugging symbols, the previous function
 754          is compiled with debugging symbols, and the "foo.o" symbol
 755          that is supposed to tell us where the file with debugging symbols
 756          ends has been truncated by ar because it is longer than 15
 757          characters).
 758
 759          So look in the minimal symbol tables as well, and if it comes
 760          up with a larger address for the function use that instead.
 761          I don't think this can ever cause any problems; there shouldn't
 762          be any minimal symbols in the middle of a function.
 763          FIXME:  (Not necessarily true.  What about text labels) */
 764
 765       struct minimal_symbol *msymbol = lookup_minimal_symbol_by_pc (fi->pc);
 766
 767       if (msymbol != NULL
 768           && (SYMBOL_VALUE_ADDRESS (msymbol)
 769               > BLOCK_START (SYMBOL_BLOCK_VALUE (func))))
 770         funname = DEPRECATED_SYMBOL_NAME (msymbol);
 771       else
 772         funname = DEPRECATED_SYMBOL_NAME (func);
 773     }
 774   else
 775     {
 776       struct minimal_symbol *msymbol =
 777       lookup_minimal_symbol_by_pc (fi->pc);
 778
 779       if (msymbol != NULL)
 780         funname = DEPRECATED_SYMBOL_NAME (msymbol);
 781     }
 782
 783   the_common = find_common_for_function (comname, funname);
 784
 785   return (the_common ? 1 : 0);
 786 }
 787 #endif
 788
 789 void
 790 _initialize_f_valprint (void)
 791 {
 792   add_info ("common", info_common_command,
 793             _("Print out the values contained in a Fortran COMMON block."));
 794   if (xdb_commands)
 795     add_com ("lc", class_info, info_common_command,
 796              _("Print out the values contained in a Fortran COMMON block."));
 797 }