gdb/f-valprint.c

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