gdb/f-valprint.c

   1 /* Support for printing Fortran values for GDB, the GNU debugger.
   2    Copyright 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2003
   3    Free Software Foundation, Inc.
   4    Contributed by Motorola.  Adapted from the C definitions by Farooq Butt
   5    (fmbutt@engage.sps.mot.com), additionally worked over by Stan Shebs.
   6
   7    This file is part of GDB.
   8
   9    This program is free software; you can redistribute it and/or modify
  10    it under the terms of the GNU General Public License as published by
  11    the Free Software Foundation; either version 2 of the License, or
  12    (at your option) any later version.
  13
  14    This program is distributed in the hope that it will be useful,
  15    but WITHOUT ANY WARRANTY; without even the implied warranty of
  16    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17    GNU General Public License for more details.
  18
  19    You should have received a copy of the GNU General Public License
  20    along with this program; if not, write to the Free Software
  21    Foundation, Inc., 59 Temple Place - Suite 330,
  22    Boston, MA 02111-1307, USA.  */
  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_print_array (struct type *, char *, CORE_ADDR,
  46                              struct ui_file *, int, int, int,
  47                              enum val_prettyprint);
  48 static void f77_print_array_1 (int, int, struct type *, char *,
  49                                CORE_ADDR, struct ui_file *, int, int, int,
  50                                enum val_prettyprint);
  51 static void f77_create_arrayprint_offset_tbl (struct type *,
  52                                               struct ui_file *);
  53 static void f77_get_dynamic_length_of_aggregate (struct type *);
  54
  55 int f77_array_offset_tbl[MAX_FORTRAN_DIMS + 1][2];
  56
  57 /* Array which holds offsets to be applied to get a row's elements
  58    for a given array. Array also holds the size of each subarray.  */
  59
  60 /* The following macro gives us the size of the nth dimension, Where
  61    n is 1 based. */
  62
  63 #define F77_DIM_SIZE(n) (f77_array_offset_tbl[n][1])
  64
  65 /* The following gives us the offset for row n where n is 1-based. */
  66
  67 #define F77_DIM_OFFSET(n) (f77_array_offset_tbl[n][0])
  68
  69 int
  70 f77_get_dynamic_lowerbound (struct type *type, int *lower_bound)
  71 {
  72   CORE_ADDR current_frame_addr;
  73   CORE_ADDR ptr_to_lower_bound;
  74
  75   switch (TYPE_ARRAY_LOWER_BOUND_TYPE (type))
  76     {
  77     case BOUND_BY_VALUE_ON_STACK:
  78       current_frame_addr = get_frame_base (deprecated_selected_frame);
  79       if (current_frame_addr > 0)
  80         {
  81           *lower_bound =
  82             read_memory_integer (current_frame_addr +
  83                                  TYPE_ARRAY_LOWER_BOUND_VALUE (type),
  84                                  4);
  85         }
  86       else
  87         {
  88           *lower_bound = DEFAULT_LOWER_BOUND;
  89           return BOUND_FETCH_ERROR;
  90         }
  91       break;
  92
  93     case BOUND_SIMPLE:
  94       *lower_bound = TYPE_ARRAY_LOWER_BOUND_VALUE (type);
  95       break;
  96
  97     case BOUND_CANNOT_BE_DETERMINED:
  98       error ("Lower bound may not be '*' in F77");
  99       break;
 100
 101     case BOUND_BY_REF_ON_STACK:
 102       current_frame_addr = get_frame_base (deprecated_selected_frame);
 103       if (current_frame_addr > 0)
 104         {
 105           ptr_to_lower_bound =
 106             read_memory_typed_address (current_frame_addr +
 107                                        TYPE_ARRAY_LOWER_BOUND_VALUE (type),
 108                                        builtin_type_void_data_ptr);
 109           *lower_bound = read_memory_integer (ptr_to_lower_bound, 4);
 110         }
 111       else
 112         {
 113           *lower_bound = DEFAULT_LOWER_BOUND;
 114           return BOUND_FETCH_ERROR;
 115         }
 116       break;
 117
 118     case BOUND_BY_REF_IN_REG:
 119     case BOUND_BY_VALUE_IN_REG:
 120     default:
 121       error ("??? unhandled dynamic array bound type ???");
 122       break;
 123     }
 124   return BOUND_FETCH_OK;
 125 }
 126
 127 int
 128 f77_get_dynamic_upperbound (struct type *type, int *upper_bound)
 129 {
 130   CORE_ADDR current_frame_addr = 0;
 131   CORE_ADDR ptr_to_upper_bound;
 132
 133   switch (TYPE_ARRAY_UPPER_BOUND_TYPE (type))
 134     {
 135     case BOUND_BY_VALUE_ON_STACK:
 136       current_frame_addr = get_frame_base (deprecated_selected_frame);
 137       if (current_frame_addr > 0)
 138         {
 139           *upper_bound =
 140             read_memory_integer (current_frame_addr +
 141                                  TYPE_ARRAY_UPPER_BOUND_VALUE (type),
 142                                  4);
 143         }
 144       else
 145         {
 146           *upper_bound = DEFAULT_UPPER_BOUND;
 147           return BOUND_FETCH_ERROR;
 148         }
 149       break;
 150
 151     case BOUND_SIMPLE:
 152       *upper_bound = TYPE_ARRAY_UPPER_BOUND_VALUE (type);
 153       break;
 154
 155     case BOUND_CANNOT_BE_DETERMINED:
 156       /* we have an assumed size array on our hands. Assume that
 157          upper_bound == lower_bound so that we show at least
 158          1 element.If the user wants to see more elements, let
 159          him manually ask for 'em and we'll subscript the
 160          array and show him */
 161       f77_get_dynamic_lowerbound (type, upper_bound);
 162       break;
 163
 164     case BOUND_BY_REF_ON_STACK:
 165       current_frame_addr = get_frame_base (deprecated_selected_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 /* Actual function which prints out F77 arrays, Valaddr == address in
 275    the superior.  Address == the address in the inferior.  */
 276
 277 static void
 278 f77_print_array_1 (int nss, int ndimensions, struct type *type, char *valaddr,
 279                    CORE_ADDR address, struct ui_file *stream, int format,
 280                    int deref_ref, int recurse, enum val_prettyprint pretty)
 281 {
 282   int i;
 283
 284   if (nss != ndimensions)
 285     {
 286       for (i = 0; i < F77_DIM_SIZE (nss); 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);
 293           fprintf_filtered (stream, ") ");
 294         }
 295     }
 296   else
 297     {
 298       for (i = 0; (i < F77_DIM_SIZE (nss) && i < print_max); i++)
 299         {
 300           val_print (TYPE_TARGET_TYPE (type),
 301                      valaddr + i * F77_DIM_OFFSET (ndimensions),
 302                      0,
 303                      address + i * F77_DIM_OFFSET (ndimensions),
 304                      stream, format, deref_ref, recurse, pretty);
 305
 306           if (i != (F77_DIM_SIZE (nss) - 1))
 307             fprintf_filtered (stream, ", ");
 308
 309           if (i == print_max - 1)
 310             fprintf_filtered (stream, "...");
 311         }
 312     }
 313 }
 314
 315 /* This function gets called to print an F77 array, we set up some
 316    stuff and then immediately call f77_print_array_1() */
 317
 318 static void
 319 f77_print_array (struct type *type, char *valaddr, CORE_ADDR address,
 320                  struct ui_file *stream, int format, int deref_ref, int recurse,
 321                  enum val_prettyprint pretty)
 322 {
 323   int ndimensions;
 324
 325   ndimensions = calc_f77_array_dims (type);
 326
 327   if (ndimensions > MAX_FORTRAN_DIMS || ndimensions < 0)
 328     error ("Type node corrupt! F77 arrays cannot have %d subscripts (%d Max)",
 329            ndimensions, MAX_FORTRAN_DIMS);
 330
 331   /* Since F77 arrays are stored column-major, we set up an
 332      offset table to get at the various row's elements. The
 333      offset table contains entries for both offset and subarray size. */
 334
 335   f77_create_arrayprint_offset_tbl (type, stream);
 336
 337   f77_print_array_1 (1, ndimensions, type, valaddr, address, stream, format,
 338                      deref_ref, recurse, pretty);
 339 }
 340 \f
 341
 342 /* Print data of type TYPE located at VALADDR (within GDB), which came from
 343    the inferior at address ADDRESS, onto stdio stream STREAM according to
 344    FORMAT (a letter or 0 for natural format).  The data at VALADDR is in
 345    target byte order.
 346
 347    If the data are a string pointer, returns the number of string characters
 348    printed.
 349
 350    If DEREF_REF is nonzero, then dereference references, otherwise just print
 351    them like pointers.
 352
 353    The PRETTY parameter controls prettyprinting.  */
 354
 355 int
 356 f_val_print (struct type *type, char *valaddr, int embedded_offset,
 357              CORE_ADDR address, struct ui_file *stream, int format,
 358              int deref_ref, int recurse, enum val_prettyprint pretty)
 359 {
 360   register unsigned int i = 0;  /* Number of characters printed */
 361   struct type *elttype;
 362   LONGEST val;
 363   CORE_ADDR addr;
 364
 365   CHECK_TYPEDEF (type);
 366   switch (TYPE_CODE (type))
 367     {
 368     case TYPE_CODE_STRING:
 369       f77_get_dynamic_length_of_aggregate (type);
 370       LA_PRINT_STRING (stream, valaddr, TYPE_LENGTH (type), 1, 0);
 371       break;
 372
 373     case TYPE_CODE_ARRAY:
 374       fprintf_filtered (stream, "(");
 375       f77_print_array (type, valaddr, address, stream, format,
 376                        deref_ref, recurse, pretty);
 377       fprintf_filtered (stream, ")");
 378       break;
 379 #if 0
 380       /* Array of unspecified length: treat like pointer to first elt.  */
 381       valaddr = (char *) &address;
 382       /* FALL THROUGH */
 383 #endif
 384     case TYPE_CODE_PTR:
 385       if (format && format != 's')
 386         {
 387           print_scalar_formatted (valaddr, type, format, 0, stream);
 388           break;
 389         }
 390       else
 391         {
 392           addr = unpack_pointer (type, valaddr);
 393           elttype = check_typedef (TYPE_TARGET_TYPE (type));
 394
 395           if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
 396             {
 397               /* Try to print what function it points to.  */
 398               print_address_demangle (addr, stream, demangle);
 399               /* Return value is irrelevant except for string pointers.  */
 400               return 0;
 401             }
 402
 403           if (addressprint && format != 's')
 404             fprintf_filtered (stream, "0x%s", paddr_nz (addr));
 405
 406           /* For a pointer to char or unsigned char, also print the string
 407              pointed to, unless pointer is null.  */
 408           if (TYPE_LENGTH (elttype) == 1
 409               && TYPE_CODE (elttype) == TYPE_CODE_INT
 410               && (format == 0 || format == 's')
 411               && addr != 0)
 412             i = val_print_string (addr, -1, TYPE_LENGTH (elttype), stream);
 413
 414           /* Return number of characters printed, plus one for the
 415              terminating null if we have "reached the end".  */
 416           return (i + (print_max && i != print_max));
 417         }
 418       break;
 419
 420     case TYPE_CODE_FUNC:
 421       if (format)
 422         {
 423           print_scalar_formatted (valaddr, type, format, 0, stream);
 424           break;
 425         }
 426       /* FIXME, we should consider, at least for ANSI C language, eliminating
 427          the distinction made between FUNCs and POINTERs to FUNCs.  */
 428       fprintf_filtered (stream, "{");
 429       type_print (type, "", stream, -1);
 430       fprintf_filtered (stream, "} ");
 431       /* Try to print what function it points to, and its address.  */
 432       print_address_demangle (address, stream, demangle);
 433       break;
 434
 435     case TYPE_CODE_INT:
 436       format = format ? format : output_format;
 437       if (format)
 438         print_scalar_formatted (valaddr, type, format, 0, stream);
 439       else
 440         {
 441           val_print_type_code_int (type, valaddr, stream);
 442           /* C and C++ has no single byte int type, char is used instead.
 443              Since we don't know whether the value is really intended to
 444              be used as an integer or a character, print the character
 445              equivalent as well. */
 446           if (TYPE_LENGTH (type) == 1)
 447             {
 448               fputs_filtered (" ", stream);
 449               LA_PRINT_CHAR ((unsigned char) unpack_long (type, valaddr),
 450                              stream);
 451             }
 452         }
 453       break;
 454
 455     case TYPE_CODE_FLT:
 456       if (format)
 457         print_scalar_formatted (valaddr, type, format, 0, stream);
 458       else
 459         print_floating (valaddr, type, stream);
 460       break;
 461
 462     case TYPE_CODE_VOID:
 463       fprintf_filtered (stream, "VOID");
 464       break;
 465
 466     case TYPE_CODE_ERROR:
 467       fprintf_filtered (stream, "<error type>");
 468       break;
 469
 470     case TYPE_CODE_RANGE:
 471       /* FIXME, we should not ever have to print one of these yet.  */
 472       fprintf_filtered (stream, "<range type>");
 473       break;
 474
 475     case TYPE_CODE_BOOL:
 476       format = format ? format : output_format;
 477       if (format)
 478         print_scalar_formatted (valaddr, type, format, 0, stream);
 479       else
 480         {
 481           val = 0;
 482           switch (TYPE_LENGTH (type))
 483             {
 484             case 1:
 485               val = unpack_long (builtin_type_f_logical_s1, valaddr);
 486               break;
 487
 488             case 2:
 489               val = unpack_long (builtin_type_f_logical_s2, valaddr);
 490               break;
 491
 492             case 4:
 493               val = unpack_long (builtin_type_f_logical, valaddr);
 494               break;
 495
 496             default:
 497               error ("Logicals of length %d bytes not supported",
 498                      TYPE_LENGTH (type));
 499
 500             }
 501
 502           if (val == 0)
 503             fprintf_filtered (stream, ".FALSE.");
 504           else if (val == 1)
 505             fprintf_filtered (stream, ".TRUE.");
 506           else
 507             /* Not a legitimate logical type, print as an integer.  */
 508             {
 509               /* Bash the type code temporarily.  */
 510               TYPE_CODE (type) = TYPE_CODE_INT;
 511               f_val_print (type, valaddr, 0, address, stream, format,
 512                            deref_ref, recurse, pretty);
 513               /* Restore the type code so later uses work as intended. */
 514               TYPE_CODE (type) = TYPE_CODE_BOOL;
 515             }
 516         }
 517       break;
 518
 519     case TYPE_CODE_COMPLEX:
 520       switch (TYPE_LENGTH (type))
 521         {
 522         case 8:
 523           type = builtin_type_f_real;
 524           break;
 525         case 16:
 526           type = builtin_type_f_real_s8;
 527           break;
 528         case 32:
 529           type = builtin_type_f_real_s16;
 530           break;
 531         default:
 532           error ("Cannot print out complex*%d variables", TYPE_LENGTH (type));
 533         }
 534       fputs_filtered ("(", stream);
 535       print_floating (valaddr, type, stream);
 536       fputs_filtered (",", stream);
 537       print_floating (valaddr + TYPE_LENGTH (type), type, stream);
 538       fputs_filtered (")", stream);
 539       break;
 540
 541     case TYPE_CODE_UNDEF:
 542       /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
 543          dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
 544          and no complete type for struct foo in that file.  */
 545       fprintf_filtered (stream, "<incomplete type>");
 546       break;
 547
 548     default:
 549       error ("Invalid F77 type code %d in symbol table.", TYPE_CODE (type));
 550     }
 551   gdb_flush (stream);
 552   return 0;
 553 }
 554
 555 static void
 556 list_all_visible_commons (char *funname)
 557 {
 558   SAVED_F77_COMMON_PTR tmp;
 559
 560   tmp = head_common_list;
 561
 562   printf_filtered ("All COMMON blocks visible at this level:\n\n");
 563
 564   while (tmp != NULL)
 565     {
 566       if (strcmp (tmp->owning_function, funname) == 0)
 567         printf_filtered ("%s\n", tmp->name);
 568
 569       tmp = tmp->next;
 570     }
 571 }
 572
 573 /* This function is used to print out the values in a given COMMON
 574    block. It will always use the most local common block of the
 575    given name */
 576
 577 static void
 578 info_common_command (char *comname, int from_tty)
 579 {
 580   SAVED_F77_COMMON_PTR the_common;
 581   COMMON_ENTRY_PTR entry;
 582   struct frame_info *fi;
 583   register char *funname = 0;
 584   struct symbol *func;
 585
 586   /* We have been told to display the contents of F77 COMMON
 587      block supposedly visible in this function.  Let us
 588      first make sure that it is visible and if so, let
 589      us display its contents */
 590
 591   fi = deprecated_selected_frame;
 592
 593   if (fi == NULL)
 594     error ("No frame selected");
 595
 596   /* The following is generally ripped off from stack.c's routine
 597      print_frame_info() */
 598
 599   func = find_pc_function (get_frame_pc (fi));
 600   if (func)
 601     {
 602       /* In certain pathological cases, the symtabs give the wrong
 603          function (when we are in the first function in a file which
 604          is compiled without debugging symbols, the previous function
 605          is compiled with debugging symbols, and the "foo.o" symbol
 606          that is supposed to tell us where the file with debugging symbols
 607          ends has been truncated by ar because it is longer than 15
 608          characters).
 609
 610          So look in the minimal symbol tables as well, and if it comes
 611          up with a larger address for the function use that instead.
 612          I don't think this can ever cause any problems; there shouldn't
 613          be any minimal symbols in the middle of a function.
 614          FIXME:  (Not necessarily true.  What about text labels) */
 615
 616       struct minimal_symbol *msymbol = lookup_minimal_symbol_by_pc (get_frame_pc (fi));
 617
 618       if (msymbol != NULL
 619           && (SYMBOL_VALUE_ADDRESS (msymbol)
 620               > BLOCK_START (SYMBOL_BLOCK_VALUE (func))))
 621         funname = DEPRECATED_SYMBOL_NAME (msymbol);
 622       else
 623         funname = DEPRECATED_SYMBOL_NAME (func);
 624     }
 625   else
 626     {
 627       register struct minimal_symbol *msymbol =
 628       lookup_minimal_symbol_by_pc (get_frame_pc (fi));
 629
 630       if (msymbol != NULL)
 631         funname = DEPRECATED_SYMBOL_NAME (msymbol);
 632     }
 633
 634   /* If comname is NULL, we assume the user wishes to see the
 635      which COMMON blocks are visible here and then return */
 636
 637   if (comname == 0)
 638     {
 639       list_all_visible_commons (funname);
 640       return;
 641     }
 642
 643   the_common = find_common_for_function (comname, funname);
 644
 645   if (the_common)
 646     {
 647       if (strcmp (comname, BLANK_COMMON_NAME_LOCAL) == 0)
 648         printf_filtered ("Contents of blank COMMON block:\n");
 649       else
 650         printf_filtered ("Contents of F77 COMMON block '%s':\n", comname);
 651
 652       printf_filtered ("\n");
 653       entry = the_common->entries;
 654
 655       while (entry != NULL)
 656         {
 657           printf_filtered ("%s = ", DEPRECATED_SYMBOL_NAME (entry->symbol));
 658           print_variable_value (entry->symbol, fi, gdb_stdout);
 659           printf_filtered ("\n");
 660           entry = entry->next;
 661         }
 662     }
 663   else
 664     printf_filtered ("Cannot locate the common block %s in function '%s'\n",
 665                      comname, funname);
 666 }
 667
 668 /* This function is used to determine whether there is a
 669    F77 common block visible at the current scope called 'comname'. */
 670
 671 #if 0
 672 static int
 673 there_is_a_visible_common_named (char *comname)
 674 {
 675   SAVED_F77_COMMON_PTR the_common;
 676   struct frame_info *fi;
 677   register char *funname = 0;
 678   struct symbol *func;
 679
 680   if (comname == NULL)
 681     error ("Cannot deal with NULL common name!");
 682
 683   fi = deprecated_selected_frame;
 684
 685   if (fi == NULL)
 686     error ("No frame selected");
 687
 688   /* The following is generally ripped off from stack.c's routine
 689      print_frame_info() */
 690
 691   func = find_pc_function (fi->pc);
 692   if (func)
 693     {
 694       /* In certain pathological cases, the symtabs give the wrong
 695          function (when we are in the first function in a file which
 696          is compiled without debugging symbols, the previous function
 697          is compiled with debugging symbols, and the "foo.o" symbol
 698          that is supposed to tell us where the file with debugging symbols
 699          ends has been truncated by ar because it is longer than 15
 700          characters).
 701
 702          So look in the minimal symbol tables as well, and if it comes
 703          up with a larger address for the function use that instead.
 704          I don't think this can ever cause any problems; there shouldn't
 705          be any minimal symbols in the middle of a function.
 706          FIXME:  (Not necessarily true.  What about text labels) */
 707
 708       struct minimal_symbol *msymbol = lookup_minimal_symbol_by_pc (fi->pc);
 709
 710       if (msymbol != NULL
 711           && (SYMBOL_VALUE_ADDRESS (msymbol)
 712               > BLOCK_START (SYMBOL_BLOCK_VALUE (func))))
 713         funname = DEPRECATED_SYMBOL_NAME (msymbol);
 714       else
 715         funname = DEPRECATED_SYMBOL_NAME (func);
 716     }
 717   else
 718     {
 719       register struct minimal_symbol *msymbol =
 720       lookup_minimal_symbol_by_pc (fi->pc);
 721
 722       if (msymbol != NULL)
 723         funname = DEPRECATED_SYMBOL_NAME (msymbol);
 724     }
 725
 726   the_common = find_common_for_function (comname, funname);
 727
 728   return (the_common ? 1 : 0);
 729 }
 730 #endif
 731
 732 void
 733 _initialize_f_valprint (void)
 734 {
 735   add_info ("common", info_common_command,
 736             "Print out the values contained in a Fortran COMMON block.");
 737   if (xdb_commands)
 738     add_com ("lc", class_info, info_common_command,
 739              "Print out the values contained in a Fortran COMMON block.");
 740 }