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
 388     case TYPE_CODE_PTR:
 389       if (format && format != 's')
 390         {
 391           print_scalar_formatted (valaddr, type, format, 0, stream);
 392           break;
 393         }
 394       else
 395         {
 396           addr = unpack_pointer (type, valaddr);
 397           elttype = check_typedef (TYPE_TARGET_TYPE (type));
 398
 399           if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
 400             {
 401               /* Try to print what function it points to.  */
 402               print_address_demangle (addr, stream, demangle);
 403               /* Return value is irrelevant except for string pointers.  */
 404               return 0;
 405             }
 406
 407           if (addressprint && format != 's')
 408             print_address_numeric (addr, 1, stream);
 409
 410           /* For a pointer to char or unsigned char, also print the string
 411              pointed to, unless pointer is null.  */
 412           if (TYPE_LENGTH (elttype) == 1
 413               && TYPE_CODE (elttype) == TYPE_CODE_INT
 414               && (format == 0 || format == 's')
 415               && addr != 0)
 416             i = val_print_string (addr, -1, TYPE_LENGTH (elttype), stream);
 417
 418           /* Return number of characters printed, including the terminating
 419              '\0' if we reached the end.  val_print_string takes care including
 420              the terminating '\0' if necessary.  */
 421           return i;
 422         }
 423       break;
 424
 425     case TYPE_CODE_REF:
 426       elttype = check_typedef (TYPE_TARGET_TYPE (type));
 427       if (addressprint)
 428         {
 429           CORE_ADDR addr
 430             = extract_typed_address (valaddr + embedded_offset, type);
 431           fprintf_filtered (stream, "@");
 432           print_address_numeric (addr, 1, stream);
 433           if (deref_ref)
 434             fputs_filtered (": ", stream);
 435         }
 436       /* De-reference the reference.  */
 437       if (deref_ref)
 438         {
 439           if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
 440             {
 441               struct value *deref_val =
 442               value_at
 443               (TYPE_TARGET_TYPE (type),
 444                unpack_pointer (lookup_pointer_type (builtin_type_void),
 445                                valaddr + embedded_offset));
 446               val_print (VALUE_TYPE (deref_val),
 447                          VALUE_CONTENTS (deref_val),
 448                          0,
 449                          VALUE_ADDRESS (deref_val),
 450                          stream,
 451                          format,
 452                          deref_ref,
 453                          recurse,
 454                          pretty);
 455             }
 456           else
 457             fputs_filtered ("???", stream);
 458         }
 459       break;
 460
 461     case TYPE_CODE_FUNC:
 462       if (format)
 463         {
 464           print_scalar_formatted (valaddr, type, format, 0, stream);
 465           break;
 466         }
 467       /* FIXME, we should consider, at least for ANSI C language, eliminating
 468          the distinction made between FUNCs and POINTERs to FUNCs.  */
 469       fprintf_filtered (stream, "{");
 470       type_print (type, "", stream, -1);
 471       fprintf_filtered (stream, "} ");
 472       /* Try to print what function it points to, and its address.  */
 473       print_address_demangle (address, stream, demangle);
 474       break;
 475
 476     case TYPE_CODE_INT:
 477       format = format ? format : output_format;
 478       if (format)
 479         print_scalar_formatted (valaddr, type, format, 0, stream);
 480       else
 481         {
 482           val_print_type_code_int (type, valaddr, stream);
 483           /* C and C++ has no single byte int type, char is used instead.
 484              Since we don't know whether the value is really intended to
 485              be used as an integer or a character, print the character
 486              equivalent as well. */
 487           if (TYPE_LENGTH (type) == 1)
 488             {
 489               fputs_filtered (" ", stream);
 490               LA_PRINT_CHAR ((unsigned char) unpack_long (type, valaddr),
 491                              stream);
 492             }
 493         }
 494       break;
 495
 496     case TYPE_CODE_FLT:
 497       if (format)
 498         print_scalar_formatted (valaddr, type, format, 0, stream);
 499       else
 500         print_floating (valaddr, type, stream);
 501       break;
 502
 503     case TYPE_CODE_VOID:
 504       fprintf_filtered (stream, "VOID");
 505       break;
 506
 507     case TYPE_CODE_ERROR:
 508       fprintf_filtered (stream, "<error type>");
 509       break;
 510
 511     case TYPE_CODE_RANGE:
 512       /* FIXME, we should not ever have to print one of these yet.  */
 513       fprintf_filtered (stream, "<range type>");
 514       break;
 515
 516     case TYPE_CODE_BOOL:
 517       format = format ? format : output_format;
 518       if (format)
 519         print_scalar_formatted (valaddr, type, format, 0, stream);
 520       else
 521         {
 522           val = 0;
 523           switch (TYPE_LENGTH (type))
 524             {
 525             case 1:
 526               val = unpack_long (builtin_type_f_logical_s1, valaddr);
 527               break;
 528
 529             case 2:
 530               val = unpack_long (builtin_type_f_logical_s2, valaddr);
 531               break;
 532
 533             case 4:
 534               val = unpack_long (builtin_type_f_logical, valaddr);
 535               break;
 536
 537             default:
 538               error ("Logicals of length %d bytes not supported",
 539                      TYPE_LENGTH (type));
 540
 541             }
 542
 543           if (val == 0)
 544             fprintf_filtered (stream, ".FALSE.");
 545           else if (val == 1)
 546             fprintf_filtered (stream, ".TRUE.");
 547           else
 548             /* Not a legitimate logical type, print as an integer.  */
 549             {
 550               /* Bash the type code temporarily.  */
 551               TYPE_CODE (type) = TYPE_CODE_INT;
 552               f_val_print (type, valaddr, 0, address, stream, format,
 553                            deref_ref, recurse, pretty);
 554               /* Restore the type code so later uses work as intended. */
 555               TYPE_CODE (type) = TYPE_CODE_BOOL;
 556             }
 557         }
 558       break;
 559
 560     case TYPE_CODE_COMPLEX:
 561       switch (TYPE_LENGTH (type))
 562         {
 563         case 8:
 564           type = builtin_type_f_real;
 565           break;
 566         case 16:
 567           type = builtin_type_f_real_s8;
 568           break;
 569         case 32:
 570           type = builtin_type_f_real_s16;
 571           break;
 572         default:
 573           error ("Cannot print out complex*%d variables", TYPE_LENGTH (type));
 574         }
 575       fputs_filtered ("(", stream);
 576       print_floating (valaddr, type, stream);
 577       fputs_filtered (",", stream);
 578       print_floating (valaddr + TYPE_LENGTH (type), type, stream);
 579       fputs_filtered (")", stream);
 580       break;
 581
 582     case TYPE_CODE_UNDEF:
 583       /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
 584          dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
 585          and no complete type for struct foo in that file.  */
 586       fprintf_filtered (stream, "<incomplete type>");
 587       break;
 588
 589     default:
 590       error ("Invalid F77 type code %d in symbol table.", TYPE_CODE (type));
 591     }
 592   gdb_flush (stream);
 593   return 0;
 594 }
 595
 596 static void
 597 list_all_visible_commons (char *funname)
 598 {
 599   SAVED_F77_COMMON_PTR tmp;
 600
 601   tmp = head_common_list;
 602
 603   printf_filtered ("All COMMON blocks visible at this level:\n\n");
 604
 605   while (tmp != NULL)
 606     {
 607       if (strcmp (tmp->owning_function, funname) == 0)
 608         printf_filtered ("%s\n", tmp->name);
 609
 610       tmp = tmp->next;
 611     }
 612 }
 613
 614 /* This function is used to print out the values in a given COMMON
 615    block. It will always use the most local common block of the
 616    given name */
 617
 618 static void
 619 info_common_command (char *comname, int from_tty)
 620 {
 621   SAVED_F77_COMMON_PTR the_common;
 622   COMMON_ENTRY_PTR entry;
 623   struct frame_info *fi;
 624   char *funname = 0;
 625   struct symbol *func;
 626
 627   /* We have been told to display the contents of F77 COMMON
 628      block supposedly visible in this function.  Let us
 629      first make sure that it is visible and if so, let
 630      us display its contents */
 631
 632   fi = deprecated_selected_frame;
 633
 634   if (fi == NULL)
 635     error ("No frame selected");
 636
 637   /* The following is generally ripped off from stack.c's routine
 638      print_frame_info() */
 639
 640   func = find_pc_function (get_frame_pc (fi));
 641   if (func)
 642     {
 643       /* In certain pathological cases, the symtabs give the wrong
 644          function (when we are in the first function in a file which
 645          is compiled without debugging symbols, the previous function
 646          is compiled with debugging symbols, and the "foo.o" symbol
 647          that is supposed to tell us where the file with debugging symbols
 648          ends has been truncated by ar because it is longer than 15
 649          characters).
 650
 651          So look in the minimal symbol tables as well, and if it comes
 652          up with a larger address for the function use that instead.
 653          I don't think this can ever cause any problems; there shouldn't
 654          be any minimal symbols in the middle of a function.
 655          FIXME:  (Not necessarily true.  What about text labels) */
 656
 657       struct minimal_symbol *msymbol = lookup_minimal_symbol_by_pc (get_frame_pc (fi));
 658
 659       if (msymbol != NULL
 660           && (SYMBOL_VALUE_ADDRESS (msymbol)
 661               > BLOCK_START (SYMBOL_BLOCK_VALUE (func))))
 662         funname = DEPRECATED_SYMBOL_NAME (msymbol);
 663       else
 664         funname = DEPRECATED_SYMBOL_NAME (func);
 665     }
 666   else
 667     {
 668       struct minimal_symbol *msymbol =
 669       lookup_minimal_symbol_by_pc (get_frame_pc (fi));
 670
 671       if (msymbol != NULL)
 672         funname = DEPRECATED_SYMBOL_NAME (msymbol);
 673     }
 674
 675   /* If comname is NULL, we assume the user wishes to see the
 676      which COMMON blocks are visible here and then return */
 677
 678   if (comname == 0)
 679     {
 680       list_all_visible_commons (funname);
 681       return;
 682     }
 683
 684   the_common = find_common_for_function (comname, funname);
 685
 686   if (the_common)
 687     {
 688       if (strcmp (comname, BLANK_COMMON_NAME_LOCAL) == 0)
 689         printf_filtered ("Contents of blank COMMON block:\n");
 690       else
 691         printf_filtered ("Contents of F77 COMMON block '%s':\n", comname);
 692
 693       printf_filtered ("\n");
 694       entry = the_common->entries;
 695
 696       while (entry != NULL)
 697         {
 698           printf_filtered ("%s = ", DEPRECATED_SYMBOL_NAME (entry->symbol));
 699           print_variable_value (entry->symbol, fi, gdb_stdout);
 700           printf_filtered ("\n");
 701           entry = entry->next;
 702         }
 703     }
 704   else
 705     printf_filtered ("Cannot locate the common block %s in function '%s'\n",
 706                      comname, funname);
 707 }
 708
 709 /* This function is used to determine whether there is a
 710    F77 common block visible at the current scope called 'comname'. */
 711
 712 #if 0
 713 static int
 714 there_is_a_visible_common_named (char *comname)
 715 {
 716   SAVED_F77_COMMON_PTR the_common;
 717   struct frame_info *fi;
 718   char *funname = 0;
 719   struct symbol *func;
 720
 721   if (comname == NULL)
 722     error ("Cannot deal with NULL common name!");
 723
 724   fi = deprecated_selected_frame;
 725
 726   if (fi == NULL)
 727     error ("No frame selected");
 728
 729   /* The following is generally ripped off from stack.c's routine
 730      print_frame_info() */
 731
 732   func = find_pc_function (fi->pc);
 733   if (func)
 734     {
 735       /* In certain pathological cases, the symtabs give the wrong
 736          function (when we are in the first function in a file which
 737          is compiled without debugging symbols, the previous function
 738          is compiled with debugging symbols, and the "foo.o" symbol
 739          that is supposed to tell us where the file with debugging symbols
 740          ends has been truncated by ar because it is longer than 15
 741          characters).
 742
 743          So look in the minimal symbol tables as well, and if it comes
 744          up with a larger address for the function use that instead.
 745          I don't think this can ever cause any problems; there shouldn't
 746          be any minimal symbols in the middle of a function.
 747          FIXME:  (Not necessarily true.  What about text labels) */
 748
 749       struct minimal_symbol *msymbol = lookup_minimal_symbol_by_pc (fi->pc);
 750
 751       if (msymbol != NULL
 752           && (SYMBOL_VALUE_ADDRESS (msymbol)
 753               > BLOCK_START (SYMBOL_BLOCK_VALUE (func))))
 754         funname = DEPRECATED_SYMBOL_NAME (msymbol);
 755       else
 756         funname = DEPRECATED_SYMBOL_NAME (func);
 757     }
 758   else
 759     {
 760       struct minimal_symbol *msymbol =
 761       lookup_minimal_symbol_by_pc (fi->pc);
 762
 763       if (msymbol != NULL)
 764         funname = DEPRECATED_SYMBOL_NAME (msymbol);
 765     }
 766
 767   the_common = find_common_for_function (comname, funname);
 768
 769   return (the_common ? 1 : 0);
 770 }
 771 #endif
 772
 773 void
 774 _initialize_f_valprint (void)
 775 {
 776   add_info ("common", info_common_command,
 777             "Print out the values contained in a Fortran COMMON block.");
 778   if (xdb_commands)
 779     add_com ("lc", class_info, info_common_command,
 780              "Print out the values contained in a Fortran COMMON block.");
 781 }