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