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