Initial creation of sourceware repositorygdb-4_18-branchpoint

1 files changed, 767 insertions, 0 deletions

diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
new file mode 100644
index 0000000..bb0b1d0
--- /dev/null
+++ b/gdb/f-valprint.c
@@ -0,0 +1,767 @@
+/* Support for printing Fortran values for GDB, the GNU debugger.
+   Copyright 1993, 1994, 1995 Free Software Foundation, Inc.
+   Contributed by Motorola.  Adapted from the C definitions by Farooq Butt
+   (fmbutt@engage.sps.mot.com), additionally worked over by Stan Shebs.
+
+This file is part of GDB.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
+
+#include "defs.h"
+#include "gdb_string.h"
+#include "symtab.h"
+#include "gdbtypes.h"
+#include "expression.h"
+#include "value.h"
+#include "demangle.h"
+#include "valprint.h"
+#include "language.h"
+#include "f-lang.h" 
+#include "frame.h"
+#include "gdbcore.h"
+#include "command.h"
+
+#if 0
+static int there_is_a_visible_common_named PARAMS ((char *));
+#endif
+
+static void info_common_command PARAMS ((char *, int));
+static void list_all_visible_commons PARAMS ((char *));
+static void f77_print_array PARAMS ((struct type *, char *, CORE_ADDR,
+				     GDB_FILE *, int, int, int,
+				     enum val_prettyprint));
+static void f77_print_array_1 PARAMS ((int, int, struct type *, char *,
+				       CORE_ADDR, GDB_FILE *, int, int, int,
+				       enum val_prettyprint));
+static void f77_create_arrayprint_offset_tbl PARAMS ((struct type *,
+						      GDB_FILE *));
+static void f77_get_dynamic_length_of_aggregate PARAMS ((struct type *));
+
+int f77_array_offset_tbl[MAX_FORTRAN_DIMS+1][2];
+
+/* Array which holds offsets to be applied to get a row's elements
+   for a given array. Array also holds the size of each subarray.  */
+
+/* The following macro gives us the size of the nth dimension, Where 
+   n is 1 based. */ 
+
+#define F77_DIM_SIZE(n) (f77_array_offset_tbl[n][1])
+
+/* The following gives us the offset for row n where n is 1-based. */ 
+
+#define F77_DIM_OFFSET(n) (f77_array_offset_tbl[n][0])
+
+int 
+f77_get_dynamic_lowerbound (type, lower_bound)
+     struct type *type;
+     int *lower_bound; 
+{
+  CORE_ADDR current_frame_addr;   
+  CORE_ADDR ptr_to_lower_bound; 
+  
+  switch (TYPE_ARRAY_LOWER_BOUND_TYPE (type))
+    {
+    case BOUND_BY_VALUE_ON_STACK:
+      current_frame_addr = selected_frame->frame;
+      if (current_frame_addr > 0) 
+	{
+	  *lower_bound = 
+	    read_memory_integer (current_frame_addr + 
+				 TYPE_ARRAY_LOWER_BOUND_VALUE (type),
+				 4);
+	}
+      else
+	{
+	  *lower_bound = DEFAULT_LOWER_BOUND; 
+	  return BOUND_FETCH_ERROR; 
+	}
+      break; 
+      
+    case BOUND_SIMPLE:
+      *lower_bound = TYPE_ARRAY_LOWER_BOUND_VALUE (type);
+      break; 
+      
+    case BOUND_CANNOT_BE_DETERMINED: 
+      error ("Lower bound may not be '*' in F77"); 
+      break; 
+      
+    case BOUND_BY_REF_ON_STACK:
+      current_frame_addr = selected_frame->frame;
+      if (current_frame_addr > 0) 
+	{
+	  ptr_to_lower_bound = 
+	    read_memory_integer (current_frame_addr + 
+				 TYPE_ARRAY_LOWER_BOUND_VALUE (type),
+				 4);
+	  *lower_bound = read_memory_integer (ptr_to_lower_bound, 4); 
+	}
+      else
+	{
+	  *lower_bound = DEFAULT_LOWER_BOUND; 
+	  return BOUND_FETCH_ERROR; 
+	}
+      break; 
+      
+    case BOUND_BY_REF_IN_REG: 
+    case BOUND_BY_VALUE_IN_REG: 
+    default: 
+      error ("??? unhandled dynamic array bound type ???");
+      break; 
+    }
+  return BOUND_FETCH_OK;
+}
+
+int 
+f77_get_dynamic_upperbound (type, upper_bound)
+     struct type *type;
+     int *upper_bound;
+{
+  CORE_ADDR current_frame_addr = 0;
+  CORE_ADDR ptr_to_upper_bound; 
+  
+  switch (TYPE_ARRAY_UPPER_BOUND_TYPE (type))
+    {
+    case BOUND_BY_VALUE_ON_STACK:
+      current_frame_addr = selected_frame->frame;
+      if (current_frame_addr > 0) 
+	{
+	  *upper_bound = 
+	    read_memory_integer (current_frame_addr + 
+				 TYPE_ARRAY_UPPER_BOUND_VALUE (type),
+				 4);
+	}
+      else
+	{
+	  *upper_bound = DEFAULT_UPPER_BOUND; 
+	  return BOUND_FETCH_ERROR; 
+	}
+      break; 
+      
+    case BOUND_SIMPLE:
+      *upper_bound = TYPE_ARRAY_UPPER_BOUND_VALUE (type);
+      break; 
+      
+    case BOUND_CANNOT_BE_DETERMINED: 
+      /* we have an assumed size array on our hands. Assume that 
+	 upper_bound == lower_bound so that we show at least 
+	 1 element.If the user wants to see more elements, let 
+	 him manually ask for 'em and we'll subscript the 
+	 array and show him */
+      f77_get_dynamic_lowerbound (type, upper_bound);
+      break; 
+      
+    case BOUND_BY_REF_ON_STACK:
+      current_frame_addr = selected_frame->frame;
+      if (current_frame_addr > 0) 
+	{
+	  ptr_to_upper_bound = 
+	    read_memory_integer (current_frame_addr + 
+				 TYPE_ARRAY_UPPER_BOUND_VALUE (type),
+				 4);
+	  *upper_bound = read_memory_integer(ptr_to_upper_bound, 4); 
+	}
+      else
+	{
+	  *upper_bound = DEFAULT_UPPER_BOUND; 
+	  return BOUND_FETCH_ERROR;
+	}
+      break; 
+      
+    case BOUND_BY_REF_IN_REG: 
+    case BOUND_BY_VALUE_IN_REG: 
+    default: 
+      error ("??? unhandled dynamic array bound type ???");
+      break; 
+    }
+  return BOUND_FETCH_OK;
+}
+
+/* Obtain F77 adjustable array dimensions */ 
+
+static void
+f77_get_dynamic_length_of_aggregate (type)
+     struct type *type;
+{
+  int upper_bound = -1;
+  int lower_bound = 1; 
+  int retcode; 
+  
+  /* Recursively go all the way down into a possibly multi-dimensional
+     F77 array and get the bounds.  For simple arrays, this is pretty
+     easy but when the bounds are dynamic, we must be very careful 
+     to add up all the lengths correctly.  Not doing this right 
+     will lead to horrendous-looking arrays in parameter lists.
+     
+     This function also works for strings which behave very 
+     similarly to arrays.  */ 
+  
+  if (TYPE_CODE(TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY
+      || TYPE_CODE(TYPE_TARGET_TYPE (type)) == TYPE_CODE_STRING)
+    f77_get_dynamic_length_of_aggregate (TYPE_TARGET_TYPE (type));
+  
+  /* Recursion ends here, start setting up lengths.  */ 
+  retcode = f77_get_dynamic_lowerbound (type, &lower_bound); 
+  if (retcode == BOUND_FETCH_ERROR)
+    error ("Cannot obtain valid array lower bound"); 
+  
+  retcode = f77_get_dynamic_upperbound (type, &upper_bound); 
+  if (retcode == BOUND_FETCH_ERROR)
+    error ("Cannot obtain valid array upper bound"); 
+  
+  /* Patch in a valid length value. */ 
+  
+  TYPE_LENGTH (type) =
+    (upper_bound - lower_bound + 1) * TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type)));
+}       
+
+/* Function that sets up the array offset,size table for the array 
+   type "type".  */ 
+
+static void 
+f77_create_arrayprint_offset_tbl (type, stream)
+     struct type *type;
+     GDB_FILE *stream;
+{
+  struct type *tmp_type;
+  int eltlen;
+  int ndimen = 1;
+  int upper, lower, retcode; 
+  
+  tmp_type = type; 
+  
+  while ((TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)) 
+    {
+      if (TYPE_ARRAY_UPPER_BOUND_TYPE (tmp_type) == BOUND_CANNOT_BE_DETERMINED)
+	fprintf_filtered (stream, "<assumed size array> "); 
+      
+      retcode = f77_get_dynamic_upperbound (tmp_type, &upper);
+      if (retcode == BOUND_FETCH_ERROR)
+	error ("Cannot obtain dynamic upper bound"); 
+      
+      retcode = f77_get_dynamic_lowerbound(tmp_type,&lower); 
+      if (retcode == BOUND_FETCH_ERROR)
+	error("Cannot obtain dynamic lower bound"); 
+      
+      F77_DIM_SIZE (ndimen) = upper - lower + 1;
+      
+      tmp_type = TYPE_TARGET_TYPE (tmp_type);
+      ndimen++; 
+    }
+  
+  /* Now we multiply eltlen by all the offsets, so that later we 
+     can print out array elements correctly.  Up till now we 
+     know an offset to apply to get the item but we also 
+     have to know how much to add to get to the next item */
+  
+  ndimen--;
+  eltlen = TYPE_LENGTH (tmp_type); 
+  F77_DIM_OFFSET (ndimen) = eltlen;
+  while (--ndimen > 0)
+    {
+      eltlen *= F77_DIM_SIZE (ndimen + 1);
+      F77_DIM_OFFSET (ndimen) = eltlen;
+    }
+}
+
+/* Actual function which prints out F77 arrays, Valaddr == address in 
+   the superior.  Address == the address in the inferior.  */
+
+static void 
+f77_print_array_1 (nss, ndimensions, type, valaddr, address, 
+		   stream, format, deref_ref, recurse, pretty)
+     int nss;
+     int ndimensions; 
+     struct type *type;
+     char *valaddr;
+     CORE_ADDR address;
+     GDB_FILE *stream;
+     int format;
+     int deref_ref;
+     int recurse;
+     enum val_prettyprint pretty;
+{
+  int i;
+  
+  if (nss != ndimensions)
+    {
+      for (i = 0; i< F77_DIM_SIZE(nss); i++)
+	{
+	  fprintf_filtered (stream, "( ");
+	  f77_print_array_1 (nss + 1, ndimensions, TYPE_TARGET_TYPE (type),
+			    valaddr + i * F77_DIM_OFFSET (nss),
+			    address + i * F77_DIM_OFFSET (nss), 
+			    stream, format, deref_ref, recurse, pretty);
+	  fprintf_filtered (stream, ") ");
+	}
+    }
+  else
+    {
+      for (i = 0; (i < F77_DIM_SIZE (nss) && i < print_max); i++)
+	{
+	  val_print (TYPE_TARGET_TYPE (type),
+		     valaddr + i * F77_DIM_OFFSET (ndimensions),
+                     0,
+		     address + i * F77_DIM_OFFSET (ndimensions),
+		     stream, format, deref_ref, recurse, pretty); 
+
+	  if (i != (F77_DIM_SIZE (nss) - 1))
+	    fprintf_filtered (stream, ", "); 
+	  
+	  if (i == print_max - 1)
+	    fprintf_filtered (stream, "...");
+	}
+    }
+}
+
+/* This function gets called to print an F77 array, we set up some 
+   stuff and then immediately call f77_print_array_1() */
+
+static void 
+f77_print_array (type, valaddr, address, stream, format, deref_ref, recurse, 
+		 pretty)
+     struct type *type;
+     char *valaddr;
+     CORE_ADDR address;
+     GDB_FILE *stream;
+     int format;
+     int deref_ref;
+     int recurse;
+     enum val_prettyprint pretty;
+{
+  int ndimensions; 
+  
+  ndimensions = calc_f77_array_dims (type); 
+  
+  if (ndimensions > MAX_FORTRAN_DIMS || ndimensions < 0)
+    error ("Type node corrupt! F77 arrays cannot have %d subscripts (%d Max)",
+	   ndimensions, MAX_FORTRAN_DIMS);
+  
+  /* Since F77 arrays are stored column-major, we set up an 
+     offset table to get at the various row's elements. The 
+     offset table contains entries for both offset and subarray size. */ 
+  
+  f77_create_arrayprint_offset_tbl (type, stream); 
+  
+  f77_print_array_1 (1, ndimensions, type, valaddr, address, stream, format, 
+                     deref_ref, recurse, pretty);
+}
+
+
+/* Print data of type TYPE located at VALADDR (within GDB), which came from
+   the inferior at address ADDRESS, onto stdio stream STREAM according to
+   FORMAT (a letter or 0 for natural format).  The data at VALADDR is in
+   target byte order.
+   
+   If the data are a string pointer, returns the number of string characters
+   printed.
+   
+   If DEREF_REF is nonzero, then dereference references, otherwise just print
+   them like pointers.
+   
+   The PRETTY parameter controls prettyprinting.  */
+
+int
+f_val_print (type, valaddr, embedded_offset, address, stream, format, deref_ref, recurse,
+	     pretty)
+     struct type *type;
+     char *valaddr;
+     int embedded_offset;
+     CORE_ADDR address;
+     GDB_FILE *stream;
+     int format;
+     int deref_ref;
+     int recurse;
+     enum val_prettyprint pretty;
+{
+  register unsigned int i = 0;		/* Number of characters printed */
+  struct type *elttype;
+  LONGEST val;
+  CORE_ADDR addr;
+  
+  CHECK_TYPEDEF (type);
+  switch (TYPE_CODE (type))
+    {
+    case TYPE_CODE_STRING: 
+      f77_get_dynamic_length_of_aggregate (type);
+      LA_PRINT_STRING (stream, valaddr, TYPE_LENGTH (type), 1, 0);
+      break;
+      
+    case TYPE_CODE_ARRAY:
+      fprintf_filtered (stream, "("); 
+      f77_print_array (type, valaddr, address, stream, format, 
+		       deref_ref, recurse, pretty); 
+      fprintf_filtered (stream, ")");
+      break;
+#if 0
+      /* Array of unspecified length: treat like pointer to first elt.  */
+      valaddr = (char *) &address;
+      /* FALL THROUGH */
+#endif 
+    case TYPE_CODE_PTR:
+      if (format && format != 's')
+	{
+	  print_scalar_formatted (valaddr, type, format, 0, stream);
+	  break;
+	}
+      else
+	{
+	  addr = unpack_pointer (type, valaddr);
+	  elttype = check_typedef (TYPE_TARGET_TYPE (type));
+	  
+	  if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
+	    {
+	      /* Try to print what function it points to.  */
+	      print_address_demangle (addr, stream, demangle);
+	      /* Return value is irrelevant except for string pointers.  */
+	      return 0;
+	    }
+	  
+	  if (addressprint && format != 's')
+	    fprintf_filtered (stream, "0x%x", addr);
+	  
+	  /* For a pointer to char or unsigned char, also print the string
+	     pointed to, unless pointer is null.  */
+	  if (TYPE_LENGTH (elttype) == 1
+	      && TYPE_CODE (elttype) == TYPE_CODE_INT
+	      && (format == 0 || format == 's')
+	      && addr != 0)
+	    i = val_print_string (addr, -1, TYPE_LENGTH (elttype), stream);
+	  
+	  /* Return number of characters printed, plus one for the
+	     terminating null if we have "reached the end".  */
+	  return (i + (print_max && i != print_max));
+	}
+      break;
+      
+    case TYPE_CODE_FUNC:
+      if (format)
+	{
+	  print_scalar_formatted (valaddr, type, format, 0, stream);
+	  break;
+	}
+      /* FIXME, we should consider, at least for ANSI C language, eliminating
+	 the distinction made between FUNCs and POINTERs to FUNCs.  */
+      fprintf_filtered (stream, "{");
+      type_print (type, "", stream, -1);
+      fprintf_filtered (stream, "} ");
+      /* Try to print what function it points to, and its address.  */
+      print_address_demangle (address, stream, demangle);
+      break;
+      
+    case TYPE_CODE_INT:
+      format = format ? format : output_format;
+      if (format)
+	print_scalar_formatted (valaddr, type, format, 0, stream);
+      else
+	{
+	  val_print_type_code_int (type, valaddr, stream);
+	  /* C and C++ has no single byte int type, char is used instead.
+	     Since we don't know whether the value is really intended to
+	     be used as an integer or a character, print the character
+	     equivalent as well. */
+	  if (TYPE_LENGTH (type) == 1)
+	    {
+	      fputs_filtered (" ", stream);
+	      LA_PRINT_CHAR ((unsigned char) unpack_long (type, valaddr),
+			     stream);
+	    }
+	}
+      break;
+      
+    case TYPE_CODE_FLT:
+      if (format)
+	print_scalar_formatted (valaddr, type, format, 0, stream);
+      else
+	print_floating (valaddr, type, stream);
+      break;
+      
+    case TYPE_CODE_VOID:
+      fprintf_filtered (stream, "VOID");
+      break;
+      
+    case TYPE_CODE_ERROR:
+      fprintf_filtered (stream, "<error type>");
+      break;
+      
+    case TYPE_CODE_RANGE:
+      /* FIXME, we should not ever have to print one of these yet.  */
+      fprintf_filtered (stream, "<range type>");
+      break;
+      
+    case TYPE_CODE_BOOL:
+      format = format ? format : output_format;
+      if (format)
+	print_scalar_formatted (valaddr, type, format, 0, stream);
+      else
+	{
+          val = 0; 
+          switch (TYPE_LENGTH(type))
+	    {
+	    case 1:
+	      val = unpack_long (builtin_type_f_logical_s1, valaddr);
+	      break ; 
+	      
+	    case 2: 
+	      val = unpack_long (builtin_type_f_logical_s2, valaddr);
+	      break ; 
+	      
+	    case 4: 
+	      val = unpack_long (builtin_type_f_logical, valaddr);
+	      break ; 
+	      
+	    default:
+	      error ("Logicals of length %d bytes not supported",
+		     TYPE_LENGTH (type));
+	      
+	    }
+	  
+          if (val == 0) 
+	    fprintf_filtered (stream, ".FALSE.");
+          else 
+	    if (val == 1) 
+	      fprintf_filtered (stream, ".TRUE.");
+	    else
+	      /* Not a legitimate logical type, print as an integer.  */
+	      {
+		/* Bash the type code temporarily.  */
+		TYPE_CODE (type) = TYPE_CODE_INT;
+		f_val_print (type, valaddr, 0, address, stream, format, 
+			     deref_ref, recurse, pretty); 
+		/* Restore the type code so later uses work as intended. */
+		TYPE_CODE (type) = TYPE_CODE_BOOL; 
+	      }
+	}
+      break;
+      
+    case TYPE_CODE_COMPLEX:
+      switch (TYPE_LENGTH (type))
+	{
+	case 8:  type = builtin_type_f_real;  break;
+	case 16:  type = builtin_type_f_real_s8;  break;
+	case 32:  type = builtin_type_f_real_s16;  break;
+	default:
+	  error ("Cannot print out complex*%d variables", TYPE_LENGTH(type)); 
+	}
+      fputs_filtered ("(", stream);
+      print_floating (valaddr, type, stream);
+      fputs_filtered (",", stream);
+      print_floating (valaddr, type, stream);
+      fputs_filtered (")", stream);
+      break;
+      
+    case TYPE_CODE_UNDEF:
+      /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
+	 dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
+	 and no complete type for struct foo in that file.  */
+      fprintf_filtered (stream, "<incomplete type>");
+      break;
+      
+    default:
+      error ("Invalid F77 type code %d in symbol table.", TYPE_CODE (type));
+    }
+  gdb_flush (stream);
+  return 0;
+}
+
+static void
+list_all_visible_commons (funname)
+     char *funname;
+{
+  SAVED_F77_COMMON_PTR  tmp;
+  
+  tmp = head_common_list;
+  
+  printf_filtered ("All COMMON blocks visible at this level:\n\n");
+  
+  while (tmp != NULL)
+    {
+      if (STREQ(tmp->owning_function,funname))
+	printf_filtered ("%s\n", tmp->name); 
+      
+      tmp = tmp->next;
+    }
+}
+
+/* This function is used to print out the values in a given COMMON 
+   block. It will always use the most local common block of the 
+   given name */ 
+
+static void 
+info_common_command (comname, from_tty)
+     char *comname;
+     int from_tty;
+{
+  SAVED_F77_COMMON_PTR  the_common; 
+  COMMON_ENTRY_PTR entry; 
+  struct frame_info *fi;
+  register char *funname = 0;
+  struct symbol *func;
+  
+  /* We have been told to display the contents of F77 COMMON 
+     block supposedly visible in this function.  Let us 
+     first make sure that it is visible and if so, let 
+     us display its contents */ 
+  
+  fi = selected_frame; 
+  
+  if (fi == NULL)
+    error ("No frame selected"); 
+  
+  /* The following is generally ripped off from stack.c's routine 
+     print_frame_info() */ 
+  
+  func = find_pc_function (fi->pc);
+  if (func)
+    {
+      /* In certain pathological cases, the symtabs give the wrong
+	 function (when we are in the first function in a file which
+	 is compiled without debugging symbols, the previous function
+	 is compiled with debugging symbols, and the "foo.o" symbol
+	 that is supposed to tell us where the file with debugging symbols
+	 ends has been truncated by ar because it is longer than 15
+	 characters).
+	 
+	 So look in the minimal symbol tables as well, and if it comes
+	 up with a larger address for the function use that instead.
+	 I don't think this can ever cause any problems; there shouldn't
+	 be any minimal symbols in the middle of a function.
+	 FIXME:  (Not necessarily true.  What about text labels) */
+      
+      struct minimal_symbol *msymbol = lookup_minimal_symbol_by_pc (fi->pc);
+      
+      if (msymbol != NULL
+	  && (SYMBOL_VALUE_ADDRESS (msymbol) 
+	      > BLOCK_START (SYMBOL_BLOCK_VALUE (func))))
+	funname = SYMBOL_NAME (msymbol);
+      else
+	funname = SYMBOL_NAME (func);
+    }
+  else
+    {
+      register struct minimal_symbol *msymbol =
+	lookup_minimal_symbol_by_pc (fi->pc);
+      
+      if (msymbol != NULL)
+	funname = SYMBOL_NAME (msymbol);
+    }
+  
+  /* If comname is NULL, we assume the user wishes to see the 
+     which COMMON blocks are visible here and then return */ 
+  
+  if (comname == 0)
+    {
+      list_all_visible_commons (funname);
+      return; 
+    }
+  
+  the_common = find_common_for_function (comname,funname); 
+  
+  if (the_common)
+    {
+      if (STREQ(comname,BLANK_COMMON_NAME_LOCAL))
+	printf_filtered ("Contents of blank COMMON block:\n");
+      else 
+	printf_filtered ("Contents of F77 COMMON block '%s':\n",comname); 
+      
+      printf_filtered ("\n"); 
+      entry = the_common->entries; 
+      
+      while (entry != NULL)
+	{
+	  printf_filtered ("%s = ",SYMBOL_NAME(entry->symbol)); 
+	  print_variable_value (entry->symbol, fi, gdb_stdout); 
+	  printf_filtered ("\n"); 
+	  entry = entry->next; 
+	}
+    }
+  else 
+    printf_filtered ("Cannot locate the common block %s in function '%s'\n",
+		    comname, funname);
+}
+
+/* This function is used to determine whether there is a
+   F77 common block visible at the current scope called 'comname'. */ 
+
+#if 0
+static int
+there_is_a_visible_common_named (comname)
+     char *comname;
+{
+  SAVED_F77_COMMON_PTR  the_common; 
+  struct frame_info *fi;
+  register char *funname = 0;
+  struct symbol *func;
+  
+  if (comname == NULL)
+    error ("Cannot deal with NULL common name!"); 
+  
+  fi = selected_frame; 
+  
+  if (fi == NULL)
+    error ("No frame selected"); 
+  
+  /* The following is generally ripped off from stack.c's routine 
+     print_frame_info() */ 
+  
+  func = find_pc_function (fi->pc);
+  if (func)
+    {
+      /* In certain pathological cases, the symtabs give the wrong
+	 function (when we are in the first function in a file which
+	 is compiled without debugging symbols, the previous function
+	 is compiled with debugging symbols, and the "foo.o" symbol
+	 that is supposed to tell us where the file with debugging symbols
+	 ends has been truncated by ar because it is longer than 15
+	 characters).
+	 
+	 So look in the minimal symbol tables as well, and if it comes
+	 up with a larger address for the function use that instead.
+	 I don't think this can ever cause any problems; there shouldn't
+	 be any minimal symbols in the middle of a function.
+	 FIXME:  (Not necessarily true.  What about text labels) */
+      
+      struct minimal_symbol *msymbol = lookup_minimal_symbol_by_pc (fi->pc);
+      
+      if (msymbol != NULL
+	  && (SYMBOL_VALUE_ADDRESS (msymbol) 
+	      > BLOCK_START (SYMBOL_BLOCK_VALUE (func))))
+	funname = SYMBOL_NAME (msymbol);
+      else
+	funname = SYMBOL_NAME (func);
+    }
+  else
+    {
+      register struct minimal_symbol *msymbol = 
+	lookup_minimal_symbol_by_pc (fi->pc);
+      
+      if (msymbol != NULL)
+	funname = SYMBOL_NAME (msymbol);
+    }
+  
+  the_common = find_common_for_function (comname, funname); 
+  
+  return (the_common ? 1 : 0);
+}
+#endif
+
+void
+_initialize_f_valprint ()
+{
+  add_info ("common", info_common_command,
+	    "Print out the values contained in a Fortran COMMON block.");
+  if (xdb_commands)
+    add_com("lc", class_info, info_common_command,
+	    "Print out the values contained in a Fortran COMMON block.");
+}