gdb/f-valprint.c

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