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 static void
 280 f77_print_array_1 (int nss, int ndimensions, struct type *type, char *valaddr,
 281                    CORE_ADDR address, struct ui_file *stream, int format,
 282                    int deref_ref, int recurse, enum val_prettyprint pretty,
 283                    int *elts)
 284 {
 285   int i;
 286
 287   if (nss != ndimensions)
 288     {
 289       for (i = 0; (i < F77_DIM_SIZE (nss) && (*elts) < print_max); i++)
 290         {
 291           fprintf_filtered (stream, "( ");
 292           f77_print_array_1 (nss + 1, ndimensions, TYPE_TARGET_TYPE (type),
 293                              valaddr + i * F77_DIM_OFFSET (nss),
 294                              address + i * F77_DIM_OFFSET (nss),
 295                              stream, format, deref_ref, recurse, pretty, elts);
 296           fprintf_filtered (stream, ") ");
 297         }
 298       if (*elts >= print_max && i < F77_DIM_SIZE (nss)) {
 299         fprintf_filtered (stream, "...");
 300       }
 301     }
 302   else
 303     {
 304       for (i = 0; (i < F77_DIM_SIZE (nss) && (*elts) < print_max); i++, (*elts)++)
 305         {
 306           val_print (TYPE_TARGET_TYPE (type),
 307                      valaddr + i * F77_DIM_OFFSET (ndimensions),
 308                      0,
 309                      address + i * F77_DIM_OFFSET (ndimensions),
 310                      stream, format, deref_ref, recurse, pretty);
 311
 312           if (i != (F77_DIM_SIZE (nss) - 1))
 313             fprintf_filtered (stream, ", ");
 314
 315           if ((( *elts) == print_max - 1) && (i != (F77_DIM_SIZE (nss) - 1)))
 316             fprintf_filtered (stream, "...");
 317         }
 318     }
 319 }
 320
 321 /* This function gets called to print an F77 array, we set up some
 322    stuff and then immediately call f77_print_array_1() */
 323
 324 static void
 325 f77_print_array (struct type *type, char *valaddr, CORE_ADDR address,
 326                  struct ui_file *stream, int format, int deref_ref, int recurse,
 327                  enum val_prettyprint pretty)
 328 {
 329   int ndimensions;
 330   int elts = 0;
 331
 332   ndimensions = calc_f77_array_dims (type);
 333
 334   if (ndimensions > MAX_FORTRAN_DIMS || ndimensions < 0)
 335     error ("Type node corrupt! F77 arrays cannot have %d subscripts (%d Max)",
 336            ndimensions, MAX_FORTRAN_DIMS);
 337
 338   /* Since F77 arrays are stored column-major, we set up an
 339      offset table to get at the various row's elements. The
 340      offset table contains entries for both offset and subarray size. */
 341
 342   f77_create_arrayprint_offset_tbl (type, stream);
 343
 344   f77_print_array_1 (1, ndimensions, type, valaddr, address, stream, format,
 345                      deref_ref, recurse, pretty, &elts);
 346 }
 347 \f
 348
 349 /* Print data of type TYPE located at VALADDR (within GDB), which came from
 350    the inferior at address ADDRESS, onto stdio stream STREAM according to
 351    FORMAT (a letter or 0 for natural format).  The data at VALADDR is in
 352    target byte order.
 353
 354    If the data are a string pointer, returns the number of string characters
 355    printed.
 356
 357    If DEREF_REF is nonzero, then dereference references, otherwise just print
 358    them like pointers.
 359
 360    The PRETTY parameter controls prettyprinting.  */
 361
 362 int
 363 f_val_print (struct type *type, char *valaddr, int embedded_offset,
 364              CORE_ADDR address, struct ui_file *stream, int format,
 365              int deref_ref, int recurse, enum val_prettyprint pretty)
 366 {
 367   unsigned int i = 0;   /* Number of characters printed */
 368   struct type *elttype;
 369   LONGEST val;
 370   CORE_ADDR addr;
 371
 372   CHECK_TYPEDEF (type);
 373   switch (TYPE_CODE (type))
 374     {
 375     case TYPE_CODE_STRING:
 376       f77_get_dynamic_length_of_aggregate (type);
 377       LA_PRINT_STRING (stream, valaddr, TYPE_LENGTH (type), 1, 0);
 378       break;
 379
 380     case TYPE_CODE_ARRAY:
 381       fprintf_filtered (stream, "(");
 382       f77_print_array (type, valaddr, address, stream, format,
 383                        deref_ref, recurse, pretty);
 384       fprintf_filtered (stream, ")");
 385       break;
 386 #if 0
 387       /* Array of unspecified length: treat like pointer to first elt.  */
 388       valaddr = (char *) &address;
 389       /* FALL THROUGH */
 390 #endif
 391     case TYPE_CODE_PTR:
 392       if (format && format != 's')
 393         {
 394           print_scalar_formatted (valaddr, type, format, 0, stream);
 395           break;
 396         }
 397       else
 398         {
 399           addr = unpack_pointer (type, valaddr);
 400           elttype = check_typedef (TYPE_TARGET_TYPE (type));
 401
 402           if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
 403             {
 404               /* Try to print what function it points to.  */
 405               print_address_demangle (addr, stream, demangle);
 406               /* Return value is irrelevant except for string pointers.  */
 407               return 0;
 408             }
 409
 410           if (addressprint && format != 's')
 411             fprintf_filtered (stream, "0x%s", paddr_nz (addr));
 412
 413           /* For a pointer to char or unsigned char, also print the string
 414              pointed to, unless pointer is null.  */
 415           if (TYPE_LENGTH (elttype) == 1
 416               && TYPE_CODE (elttype) == TYPE_CODE_INT
 417               && (format == 0 || format == 's')
 418               && addr != 0)
 419             i = val_print_string (addr, -1, TYPE_LENGTH (elttype), stream);
 420
 421           /* Return number of characters printed, plus one for the
 422              terminating null if we have "reached the end".  */
 423           return (i + (print_max && i != print_max));
 424         }
 425       break;
 426
 427     case TYPE_CODE_FUNC:
 428       if (format)
 429         {
 430           print_scalar_formatted (valaddr, type, format, 0, stream);
 431           break;
 432         }
 433       /* FIXME, we should consider, at least for ANSI C language, eliminating
 434          the distinction made between FUNCs and POINTERs to FUNCs.  */
 435       fprintf_filtered (stream, "{");
 436       type_print (type, "", stream, -1);
 437       fprintf_filtered (stream, "} ");
 438       /* Try to print what function it points to, and its address.  */
 439       print_address_demangle (address, stream, demangle);
 440       break;
 441
 442     case TYPE_CODE_INT:
 443       format = format ? format : output_format;
 444       if (format)
 445         print_scalar_formatted (valaddr, type, format, 0, stream);
 446       else
 447         {
 448           val_print_type_code_int (type, valaddr, stream);
 449           /* C and C++ has no single byte int type, char is used instead.
 450              Since we don't know whether the value is really intended to
 451              be used as an integer or a character, print the character
 452              equivalent as well. */
 453           if (TYPE_LENGTH (type) == 1)
 454             {
 455               fputs_filtered (" ", stream);
 456               LA_PRINT_CHAR ((unsigned char) unpack_long (type, valaddr),
 457                              stream);
 458             }
 459         }
 460       break;
 461
 462     case TYPE_CODE_FLT:
 463       if (format)
 464         print_scalar_formatted (valaddr, type, format, 0, stream);
 465       else
 466         print_floating (valaddr, type, stream);
 467       break;
 468
 469     case TYPE_CODE_VOID:
 470       fprintf_filtered (stream, "VOID");
 471       break;
 472
 473     case TYPE_CODE_ERROR:
 474       fprintf_filtered (stream, "<error type>");
 475       break;
 476
 477     case TYPE_CODE_RANGE:
 478       /* FIXME, we should not ever have to print one of these yet.  */
 479       fprintf_filtered (stream, "<range type>");
 480       break;
 481
 482     case TYPE_CODE_BOOL:
 483       format = format ? format : output_format;
 484       if (format)
 485         print_scalar_formatted (valaddr, type, format, 0, stream);
 486       else
 487         {
 488           val = 0;
 489           switch (TYPE_LENGTH (type))
 490             {
 491             case 1:
 492               val = unpack_long (builtin_type_f_logical_s1, valaddr);
 493               break;
 494
 495             case 2:
 496               val = unpack_long (builtin_type_f_logical_s2, valaddr);
 497               break;
 498
 499             case 4:
 500               val = unpack_long (builtin_type_f_logical, valaddr);
 501               break;
 502
 503             default:
 504               error ("Logicals of length %d bytes not supported",
 505                      TYPE_LENGTH (type));
 506
 507             }
 508
 509           if (val == 0)
 510             fprintf_filtered (stream, ".FALSE.");
 511           else if (val == 1)
 512             fprintf_filtered (stream, ".TRUE.");
 513           else
 514             /* Not a legitimate logical type, print as an integer.  */
 515             {
 516               /* Bash the type code temporarily.  */
 517               TYPE_CODE (type) = TYPE_CODE_INT;
 518               f_val_print (type, valaddr, 0, address, stream, format,
 519                            deref_ref, recurse, pretty);
 520               /* Restore the type code so later uses work as intended. */
 521               TYPE_CODE (type) = TYPE_CODE_BOOL;
 522             }
 523         }
 524       break;
 525
 526     case TYPE_CODE_COMPLEX:
 527       switch (TYPE_LENGTH (type))
 528         {
 529         case 8:
 530           type = builtin_type_f_real;
 531           break;
 532         case 16:
 533           type = builtin_type_f_real_s8;
 534           break;
 535         case 32:
 536           type = builtin_type_f_real_s16;
 537           break;
 538         default:
 539           error ("Cannot print out complex*%d variables", TYPE_LENGTH (type));
 540         }
 541       fputs_filtered ("(", stream);
 542       print_floating (valaddr, type, stream);
 543       fputs_filtered (",", stream);
 544       print_floating (valaddr + TYPE_LENGTH (type), type, stream);
 545       fputs_filtered (")", stream);
 546       break;
 547
 548     case TYPE_CODE_UNDEF:
 549       /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
 550          dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
 551          and no complete type for struct foo in that file.  */
 552       fprintf_filtered (stream, "<incomplete type>");
 553       break;
 554
 555     default:
 556       error ("Invalid F77 type code %d in symbol table.", TYPE_CODE (type));
 557     }
 558   gdb_flush (stream);
 559   return 0;
 560 }
 561
 562 static void
 563 list_all_visible_commons (char *funname)
 564 {
 565   SAVED_F77_COMMON_PTR tmp;
 566
 567   tmp = head_common_list;
 568
 569   printf_filtered ("All COMMON blocks visible at this level:\n\n");
 570
 571   while (tmp != NULL)
 572     {
 573       if (strcmp (tmp->owning_function, funname) == 0)
 574         printf_filtered ("%s\n", tmp->name);
 575
 576       tmp = tmp->next;
 577     }
 578 }
 579
 580 /* This function is used to print out the values in a given COMMON
 581    block. It will always use the most local common block of the
 582    given name */
 583
 584 static void
 585 info_common_command (char *comname, int from_tty)
 586 {
 587   SAVED_F77_COMMON_PTR the_common;
 588   COMMON_ENTRY_PTR entry;
 589   struct frame_info *fi;
 590   char *funname = 0;
 591   struct symbol *func;
 592
 593   /* We have been told to display the contents of F77 COMMON
 594      block supposedly visible in this function.  Let us
 595      first make sure that it is visible and if so, let
 596      us display its contents */
 597
 598   fi = deprecated_selected_frame;
 599
 600   if (fi == NULL)
 601     error ("No frame selected");
 602
 603   /* The following is generally ripped off from stack.c's routine
 604      print_frame_info() */
 605
 606   func = find_pc_function (get_frame_pc (fi));
 607   if (func)
 608     {
 609       /* In certain pathological cases, the symtabs give the wrong
 610          function (when we are in the first function in a file which
 611          is compiled without debugging symbols, the previous function
 612          is compiled with debugging symbols, and the "foo.o" symbol
 613          that is supposed to tell us where the file with debugging symbols
 614          ends has been truncated by ar because it is longer than 15
 615          characters).
 616
 617          So look in the minimal symbol tables as well, and if it comes
 618          up with a larger address for the function use that instead.
 619          I don't think this can ever cause any problems; there shouldn't
 620          be any minimal symbols in the middle of a function.
 621          FIXME:  (Not necessarily true.  What about text labels) */
 622
 623       struct minimal_symbol *msymbol = lookup_minimal_symbol_by_pc (get_frame_pc (fi));
 624
 625       if (msymbol != NULL
 626           && (SYMBOL_VALUE_ADDRESS (msymbol)
 627               > BLOCK_START (SYMBOL_BLOCK_VALUE (func))))
 628         funname = DEPRECATED_SYMBOL_NAME (msymbol);
 629       else
 630         funname = DEPRECATED_SYMBOL_NAME (func);
 631     }
 632   else
 633     {
 634       register struct minimal_symbol *msymbol =
 635       lookup_minimal_symbol_by_pc (get_frame_pc (fi));
 636
 637       if (msymbol != NULL)
 638         funname = DEPRECATED_SYMBOL_NAME (msymbol);
 639     }
 640
 641   /* If comname is NULL, we assume the user wishes to see the
 642      which COMMON blocks are visible here and then return */
 643
 644   if (comname == 0)
 645     {
 646       list_all_visible_commons (funname);
 647       return;
 648     }
 649
 650   the_common = find_common_for_function (comname, funname);
 651
 652   if (the_common)
 653     {
 654       if (strcmp (comname, BLANK_COMMON_NAME_LOCAL) == 0)
 655         printf_filtered ("Contents of blank COMMON block:\n");
 656       else
 657         printf_filtered ("Contents of F77 COMMON block '%s':\n", comname);
 658
 659       printf_filtered ("\n");
 660       entry = the_common->entries;
 661
 662       while (entry != NULL)
 663         {
 664           printf_filtered ("%s = ", DEPRECATED_SYMBOL_NAME (entry->symbol));
 665           print_variable_value (entry->symbol, fi, gdb_stdout);
 666           printf_filtered ("\n");
 667           entry = entry->next;
 668         }
 669     }
 670   else
 671     printf_filtered ("Cannot locate the common block %s in function '%s'\n",
 672                      comname, funname);
 673 }
 674
 675 /* This function is used to determine whether there is a
 676    F77 common block visible at the current scope called 'comname'. */
 677
 678 #if 0
 679 static int
 680 there_is_a_visible_common_named (char *comname)
 681 {
 682   SAVED_F77_COMMON_PTR the_common;
 683   struct frame_info *fi;
 684   char *funname = 0;
 685   struct symbol *func;
 686
 687   if (comname == NULL)
 688     error ("Cannot deal with NULL common name!");
 689
 690   fi = deprecated_selected_frame;
 691
 692   if (fi == NULL)
 693     error ("No frame selected");
 694
 695   /* The following is generally ripped off from stack.c's routine
 696      print_frame_info() */
 697
 698   func = find_pc_function (fi->pc);
 699   if (func)
 700     {
 701       /* In certain pathological cases, the symtabs give the wrong
 702          function (when we are in the first function in a file which
 703          is compiled without debugging symbols, the previous function
 704          is compiled with debugging symbols, and the "foo.o" symbol
 705          that is supposed to tell us where the file with debugging symbols
 706          ends has been truncated by ar because it is longer than 15
 707          characters).
 708
 709          So look in the minimal symbol tables as well, and if it comes
 710          up with a larger address for the function use that instead.
 711          I don't think this can ever cause any problems; there shouldn't
 712          be any minimal symbols in the middle of a function.
 713          FIXME:  (Not necessarily true.  What about text labels) */
 714
 715       struct minimal_symbol *msymbol = lookup_minimal_symbol_by_pc (fi->pc);
 716
 717       if (msymbol != NULL
 718           && (SYMBOL_VALUE_ADDRESS (msymbol)
 719               > BLOCK_START (SYMBOL_BLOCK_VALUE (func))))
 720         funname = DEPRECATED_SYMBOL_NAME (msymbol);
 721       else
 722         funname = DEPRECATED_SYMBOL_NAME (func);
 723     }
 724   else
 725     {
 726       register struct minimal_symbol *msymbol =
 727       lookup_minimal_symbol_by_pc (fi->pc);
 728
 729       if (msymbol != NULL)
 730         funname = DEPRECATED_SYMBOL_NAME (msymbol);
 731     }
 732
 733   the_common = find_common_for_function (comname, funname);
 734
 735   return (the_common ? 1 : 0);
 736 }
 737 #endif
 738
 739 void
 740 _initialize_f_valprint (void)
 741 {
 742   add_info ("common", info_common_command,
 743             "Print out the values contained in a Fortran COMMON block.");
 744   if (xdb_commands)
 745     add_com ("lc", class_info, info_common_command,
 746              "Print out the values contained in a Fortran COMMON block.");
 747 }