* c-typeprint.c (c_type_print_varspec_prefix,

	 c_type_print_varspec_suffix): Add cases for Fortran type codes.
	 * eval.c (evaluate_subexp): For OP_ARRAY expressions in Fortran,
	 call f77_value_literal_string instead.
	 * f_exp.y: Include <string.h>, move include of parser-defs.h.
	 (parse_number): Translate 'd' floats to 'e' so atof() works.
	 (yylex): Remove unused variables.
	 * f-lang.c: Include <string.h>.
	 (get_bf_for_fcn): Remove unused variable.
	 * f-typeprint.c (f_type_print_varspec_prefix,
	 f_type_print_varspec_suffix): Remove unused
	 variables, add cases to switch statements.
	 (f_type_print_base): Remove unused variables.
	 * f-valprint.c (gdbcore.h, command.h): Include.
	 (f77_get_dynamic_lowerbound, f77_get_dynamic_upperbound):
	 Call read_memory_integer with correct number of arguments.
	 (f77_get_dynamic_upperbound): Call f77_get_dynamic_lowerbound
	 with correct argument type.
	 (f77_print_array): Removed unused array array_size_array.
	 (f_val_print): Don't use a CORE_ADDR as a char *.
	 * valops.c (value_cast): Handle COMPLEX and BOOL types.
	 (value_assign): Handle Fortran literal string and complex values.
	 (f77_cast_into_complex, f77_assign_from_literal_string,
	 f77_assign_from_literal_complex): New functions.

6 files changed, 110 insertions, 75 deletions

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index a4ec061..5520f01 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,30 @@
+Tue Sep  6 16:24:07 1994  Stan Shebs  (shebs@andros.cygnus.com)
+
+	 * c-typeprint.c (c_type_print_varspec_prefix,
+	 c_type_print_varspec_suffix): Add cases for Fortran type codes.
+	 * eval.c (evaluate_subexp): For OP_ARRAY expressions in Fortran,
+	 call f77_value_literal_string instead.
+	 * f_exp.y: Include <string.h>, move include of parser-defs.h.
+	 (parse_number): Translate 'd' floats to 'e' so atof() works. 
+	 (yylex): Remove unused variables.
+	 * f-lang.c: Include <string.h>.
+	 (get_bf_for_fcn): Remove unused variable.
+	 * f-typeprint.c (f_type_print_varspec_prefix,
+	 f_type_print_varspec_suffix): Remove unused
+	 variables, add cases to switch statements.
+	 (f_type_print_base): Remove unused variables.
+	 * f-valprint.c (gdbcore.h, command.h): Include.
+	 (f77_get_dynamic_lowerbound, f77_get_dynamic_upperbound):
+	 Call read_memory_integer with correct number of arguments.
+	 (f77_get_dynamic_upperbound): Call f77_get_dynamic_lowerbound
+	 with correct argument type.
+	 (f77_print_array): Removed unused array array_size_array.
+	 (f_val_print): Don't use a CORE_ADDR as a char *.
+	 * valops.c (value_cast): Handle COMPLEX and BOOL types.
+	 (value_assign): Handle Fortran literal string and complex values.
+	 (f77_cast_into_complex, f77_assign_from_literal_string,
+	 f77_assign_from_literal_complex): New functions.
+
 Mon Sep  5 14:46:41 1994  Per Bothner  (bothner@kalessin.cygnus.com)
 
 	* ch-typeprint.c (chill_type_print_base):  Make TYPE_CODE_RANGE
diff --git a/gdb/c-typeprint.c b/gdb/c-typeprint.c
index 60268b2..6d5a85a 100644
--- a/gdb/c-typeprint.c
+++ b/gdb/c-typeprint.c
@@ -312,6 +312,9 @@ c_type_print_varspec_prefix (type, stream, show, passed_a_ptr)
     case TYPE_CODE_RANGE:
     case TYPE_CODE_STRING:
     case TYPE_CODE_BITSTRING:
+    case TYPE_CODE_COMPLEX:
+    case TYPE_CODE_LITERAL_COMPLEX:
+    case TYPE_CODE_LITERAL_STRING:
       /* These types need no prefix.  They are listed here so that
 	 gcc -Wall will reveal any types that haven't been handled.  */
       break;
@@ -436,6 +439,9 @@ c_type_print_varspec_suffix (type, stream, show, passed_a_ptr, demangled_args)
     case TYPE_CODE_RANGE:
     case TYPE_CODE_STRING:
     case TYPE_CODE_BITSTRING:
+    case TYPE_CODE_COMPLEX:
+    case TYPE_CODE_LITERAL_COMPLEX:
+    case TYPE_CODE_LITERAL_STRING:
       /* These types do not need a suffix.  They are listed so that
 	 gcc -Wall will report types that may not have been considered.  */
       break;
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index 27eda23..6270fc7 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -43,9 +43,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */
 %{
 
 #include "defs.h"
+#include <string.h>
 #include "expression.h"
-#include "parser-defs.h"
 #include "value.h"
+#include "parser-defs.h"
 #include "language.h"
 #include "f-lang.h"
 #include "bfd.h" /* Required by objfiles.h.  */
@@ -214,7 +215,6 @@ type_exp:	type
 			  write_exp_elt_opcode(OP_TYPE); }
 	;
 
-
 exp     :       '(' exp ')'
         		{ }
         ;
@@ -390,8 +390,7 @@ exp	:	NAME_OR_INT
 			  write_exp_elt_opcode (OP_LONG);
 			  write_exp_elt_type (val.typed_val.type);
 			  write_exp_elt_longcst ((LONGEST)val.typed_val.val);
-			  write_exp_elt_opcode (OP_LONG);
-			}
+			  write_exp_elt_opcode (OP_LONG); }
 	;
 
 exp	:	FLOAT
@@ -668,7 +667,15 @@ parse_number (p, len, parsed_float, putithere)
   if (parsed_float)
     {
       /* It's a float since it contains a point or an exponent.  */
-      putithere->dval = atof (p);
+      /* [dD] is not understood as an exponent by atof, change it to 'e'.  */
+      char *tmp, *tmp2;
+
+      tmp = strsave (p);
+      for (tmp2 = tmp; *tmp2; ++tmp2)
+	if (*tmp2 == 'd' || *tmp2 == 'D')
+	  *tmp2 = 'e';
+      putithere->dval = atof (tmp);
+      free (tmp);
       return FLOAT;
     }
 
@@ -931,10 +938,6 @@ yylex ()
   int namelen;
   unsigned int i,token;
   char *tokstart;
-  char *tokptr;
-  int tempbufindex;
-  static char *tempbuf;
-  static int tempbufsize;
   
  retry:
   
@@ -945,14 +948,14 @@ yylex ()
   
   if (*lexptr == '.')
     { 
-      for (i=0;boolean_values[i].name != NULL;i++)
+      for (i = 0; boolean_values[i].name != NULL; i++)
 	{
-	  if STREQN(tokstart,boolean_values[i].name,
-		    strlen(boolean_values[i].name))
+	  if STREQN (tokstart, boolean_values[i].name,
+		    strlen (boolean_values[i].name))
 	    {
-	      lexptr += strlen(boolean_values[i].name); 
+	      lexptr += strlen (boolean_values[i].name); 
 	      yylval.lval = boolean_values[i].value; 
-	      return (BOOLEAN_LITERAL);
+	      return BOOLEAN_LITERAL;
 	    }
 	}
     }
@@ -960,10 +963,9 @@ yylex ()
   /* See if it is a special .foo. operator */
   
   for (i = 0; dot_ops[i].operator != NULL; i++)
-    if (STREQN(tokstart, dot_ops[i].operator,
-               strlen(dot_ops[i].operator)))
+    if (STREQN (tokstart, dot_ops[i].operator, strlen (dot_ops[i].operator)))
       {
-	lexptr += strlen(dot_ops[i].operator);
+	lexptr += strlen (dot_ops[i].operator);
 	yylval.opcode = dot_ops[i].opcode;
 	return dot_ops[i].token;
       }
@@ -1040,12 +1042,12 @@ yylex ()
 	  {
 	    if (!hex && !got_e && (*p == 'e' || *p == 'E'))
 	      got_dot = got_e = 1;
-	    else if (!hex && !got_e && (*p == 'd' || *p == 'D'))
+	    else if (!hex && !got_d && (*p == 'd' || *p == 'D'))
 	      got_dot = got_d = 1;
 	    else if (!hex && !got_dot && *p == '.')
 	      got_dot = 1;
-	    else if ((got_e && (p[-1] == 'e' || p[-1] == 'E')
-		      || got_d && (p[-1] == 'd' || p[-1] == 'D'))
+	    else if ((got_e && (p[-1] == 'e' || p[-1] == 'E'))
+		     || (got_d && (p[-1] == 'd' || p[-1] == 'D'))
 		     && (*p == '-' || *p == '+'))
 	      /* This is the sign of the exponent, not the end of the
 		 number.  */
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index f9d55b7..77dce4f 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -20,6 +20,7 @@ along with this program; if not, write to the Free Software
 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */
 
 #include "defs.h"
+#include <string.h>
 #include "symtab.h"
 #include "gdbtypes.h"
 #include "expression.h"
@@ -882,7 +883,6 @@ get_bf_for_fcn (the_function)
 {
   SAVED_BF_PTR tmp;
   int nprobes = 0;
-  long retval = 0; 
   
   /* First use a simple queuing algorithm (i.e. look and see if the 
      item at the head of the queue is the one you want)  */
diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c
index 3540f48..85f01e9 100644
--- a/gdb/f-typeprint.c
+++ b/gdb/f-typeprint.c
@@ -1,5 +1,5 @@
 /* Support for printing Fortran types for GDB, the GNU debugger.
-   Copyright 1986, 1988, 1989, 1991 Free Software Foundation, Inc.
+   Copyright 1986, 1988, 1989, 1991, 1993, 1994 Free Software Foundation, Inc.
    Contributed by Motorola.  Adapted from the C version by Farooq Butt
    (fmbutt@engage.sps.mot.com).
 
@@ -102,7 +102,6 @@ f_type_print_varspec_prefix (type, stream, show, passed_a_ptr)
      int show;
      int passed_a_ptr;
 {
-  char *name;
   if (type == 0)
     return;
 
@@ -140,6 +139,13 @@ f_type_print_varspec_prefix (type, stream, show, passed_a_ptr)
     case TYPE_CODE_SET:
     case TYPE_CODE_RANGE:
     case TYPE_CODE_STRING:
+    case TYPE_CODE_BITSTRING:
+    case TYPE_CODE_METHOD:
+    case TYPE_CODE_MEMBER:
+    case TYPE_CODE_REF:
+    case TYPE_CODE_COMPLEX:
+    case TYPE_CODE_LITERAL_COMPLEX:
+    case TYPE_CODE_LITERAL_STRING:
       /* These types need no prefix.  They are listed here so that
 	 gcc -Wall will reveal any types that haven't been handled.  */
       break;
@@ -192,8 +198,7 @@ f_type_print_varspec_suffix (type, stream, show, passed_a_ptr, demangled_args)
      int passed_a_ptr;
      int demangled_args;
 {
-  CORE_ADDR current_frame_addr = 0;
-  int upper_bound,lower_bound;
+  int upper_bound, lower_bound;
   int lower_bound_was_default = 0;
   static int arrayprint_recurse_level = 0;
   int retcode;
@@ -281,15 +286,19 @@ f_type_print_varspec_suffix (type, stream, show, passed_a_ptr, demangled_args)
     case TYPE_CODE_BOOL:
     case TYPE_CODE_SET:
     case TYPE_CODE_RANGE:
-    case TYPE_CODE_LITERAL_STRING:
     case TYPE_CODE_STRING:
+    case TYPE_CODE_BITSTRING:
+    case TYPE_CODE_METHOD:
+    case TYPE_CODE_MEMBER:
+    case TYPE_CODE_COMPLEX:
+    case TYPE_CODE_LITERAL_COMPLEX:
+    case TYPE_CODE_LITERAL_STRING:
       /* These types do not need a suffix.  They are listed so that
 	 gcc -Wall will report types that may not have been considered.  */
       break;
     }
 }
 
-
 void
 print_equivalent_f77_float_type (type, stream)
      struct type *type;
@@ -331,14 +340,9 @@ f_type_print_base (type, stream, show, level)
      int show;
      int level;
 {
-  char *name;
-  register int i;
-  register int len;
-  register int lastval;
-  char *mangled_name;
-  char *demangled_name;
-  enum {s_none, s_public, s_private, s_protected} section_type;
-  int retcode,upper_bound;
+  int retcode;
+  int upper_bound;
+
   QUIT;
 
   wrap_here ("    ");
@@ -353,9 +357,6 @@ f_type_print_base (type, stream, show, level)
 
   if ((show <= 0) && (TYPE_NAME (type) != NULL))
     {
-      /* Damn builtin types on RS6000!  They call a float "float"
-         so we gotta translate to appropriate F77'isms */
-
       if (TYPE_CODE (type) == TYPE_CODE_FLT)
 	print_equivalent_f77_float_type (type, stream);
       else
@@ -405,20 +406,20 @@ f_type_print_base (type, stream, show, level)
          through as TYPE_CODE_INT since dbxstclass.h is so
          C-oriented, we must change these to "character" from "char".  */
 
-      if (STREQ(TYPE_NAME(type),"char"))
-	fprintf_filtered (stream,"character");
+      if (STREQ (TYPE_NAME (type), "char"))
+	fprintf_filtered (stream, "character");
       else
 	goto default_case;
       break;
 
     case TYPE_CODE_COMPLEX:
     case TYPE_CODE_LITERAL_COMPLEX:
-      fprintf_filtered (stream,"complex*");
-      fprintf_filtered (stream,"%d",TYPE_LENGTH(type));
+      fprintf_filtered (stream, "complex*");
+      fprintf_filtered (stream, "%d", TYPE_LENGTH (type));
       break;
 
     case TYPE_CODE_FLT:
-      print_equivalent_f77_float_type(type,stream);
+      print_equivalent_f77_float_type (type, stream);
       break;
 
     case TYPE_CODE_LITERAL_STRING:
@@ -427,18 +428,18 @@ f_type_print_base (type, stream, show, level)
        break;
 
     case TYPE_CODE_STRING:
-      /* Strings may have dynamic upperbounds (lengths) like arrays */
+      /* Strings may have dynamic upperbounds (lengths) like arrays. */
 
       if (TYPE_ARRAY_UPPER_BOUND_TYPE (type) == BOUND_CANNOT_BE_DETERMINED)
-	fprintf_filtered("character*(*)");
+	fprintf_filtered ("character*(*)");
       else
 	{
-	  retcode = f77_get_dynamic_upperbound(type,&upper_bound);
+	  retcode = f77_get_dynamic_upperbound (type, &upper_bound);
 
 	  if (retcode == BOUND_FETCH_ERROR)
-	    fprintf_filtered(stream,"character*???");
+	    fprintf_filtered (stream, "character*???");
 	  else
-	    fprintf_filtered(stream,"character*%d",upper_bound);
+	    fprintf_filtered (stream, "character*%d", upper_bound);
 	}
       break;
 
diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
index 0e0cdbc..2f2bd14 100644
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -20,6 +20,7 @@ along with this program; if not, write to the Free Software
 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */
 
 #include "defs.h"
+#include <string.h>
 #include "symtab.h"
 #include "gdbtypes.h"
 #include "expression.h"
@@ -29,11 +30,15 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */
 #include "language.h"
 #include "f-lang.h" 
 #include "frame.h"
+#include "gdbcore.h"
+#include "command.h"
 
 extern struct obstack dont_print_obstack;
 
 extern unsigned int print_max; /* No of array elements to print */ 
 
+extern int calc_f77_array_dims 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
@@ -64,7 +69,8 @@ f77_get_dynamic_lowerbound (type, lower_bound)
 	{
 	  *lower_bound = 
 	    read_memory_integer (current_frame_addr + 
-				 TYPE_ARRAY_LOWER_BOUND_VALUE (type),4);
+				 TYPE_ARRAY_LOWER_BOUND_VALUE (type),
+				 4);
 	}
       else
 	{
@@ -78,7 +84,7 @@ f77_get_dynamic_lowerbound (type, lower_bound)
       break; 
       
     case BOUND_CANNOT_BE_DETERMINED: 
-      error("Lower bound may not be '*' in F77"); 
+      error ("Lower bound may not be '*' in F77"); 
       break; 
       
     case BOUND_BY_REF_ON_STACK:
@@ -89,7 +95,7 @@ f77_get_dynamic_lowerbound (type, lower_bound)
 	    read_memory_integer (current_frame_addr + 
 				 TYPE_ARRAY_LOWER_BOUND_VALUE (type),
 				 4);
-	  *lower_bound = read_memory_integer(ptr_to_lower_bound); 
+	  *lower_bound = read_memory_integer (ptr_to_lower_bound, 4); 
 	}
       else
 	{
@@ -123,7 +129,8 @@ f77_get_dynamic_upperbound (type, upper_bound)
 	{
 	  *upper_bound = 
 	    read_memory_integer (current_frame_addr + 
-				 TYPE_ARRAY_UPPER_BOUND_VALUE (type),4);
+				 TYPE_ARRAY_UPPER_BOUND_VALUE (type),
+				 4);
 	}
       else
 	{
@@ -142,7 +149,7 @@ f77_get_dynamic_upperbound (type, upper_bound)
 	 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);
+      f77_get_dynamic_lowerbound (type, upper_bound);
       break; 
       
     case BOUND_BY_REF_ON_STACK:
@@ -153,7 +160,7 @@ f77_get_dynamic_upperbound (type, upper_bound)
 	    read_memory_integer (current_frame_addr + 
 				 TYPE_ARRAY_UPPER_BOUND_VALUE (type),
 				 4);
-	  *upper_bound = read_memory_integer(ptr_to_upper_bound); 
+	  *upper_bound = read_memory_integer(ptr_to_upper_bound, 4); 
 	}
       else
 	{
@@ -179,13 +186,11 @@ f77_get_dynamic_length_of_aggregate (type)
 {
   int upper_bound = -1;
   int lower_bound = 1; 
-  unsigned int current_total = 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 
+  /* 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.
      
@@ -224,7 +229,6 @@ f77_print_cmplx (valaddr, type, stream, which_complex)
 {
   float *f1,*f2;
   double *d1, *d2;
-  int i; 
   
   switch (which_complex)
     {
@@ -267,7 +271,7 @@ f77_print_cmplx (valaddr, type, stream, which_complex)
 }
 
 /* Function that sets up the array offset,size table for the array 
-   type "type". */ 
+   type "type".  */ 
 
 void 
 f77_create_arrayprint_offset_tbl (type, stream)
@@ -388,7 +392,6 @@ f77_print_array (type, valaddr, address, stream, format, deref_ref, recurse,
      int recurse;
      enum val_prettyprint pretty;
 {
-  int array_size_array[MAX_FORTRAN_DIMS+1]; 
   int ndimensions; 
   
   ndimensions = calc_f77_array_dims (type); 
@@ -436,11 +439,9 @@ f_val_print (type, valaddr, address, stream, format, deref_ref, recurse,
   register unsigned int i = 0;		/* Number of characters printed */
   unsigned len;
   struct type *elttype;
-  unsigned eltlen;
   LONGEST val;
-  struct internalvar *ivar; 
-  char *localstr; 
-  unsigned char c;
+  char *localstr;
+  char *straddr;
   CORE_ADDR addr;
   
   switch (TYPE_CODE (type))
@@ -454,15 +455,15 @@ f_val_print (type, valaddr, address, stream, format, deref_ref, recurse,
 	 and for straight literals (i.e. of the form 'hello world'), 
 	 valaddr points a ptr to VALUE_LITERAL_DATA(value). */
       
-      /* First deref. valaddr  */ 
+      /* First dereference valaddr.  */ 
       
-      addr = * (CORE_ADDR *) valaddr; 
+      straddr = * (CORE_ADDR *) valaddr; 
       
-      if (addr)
+      if (straddr)
 	{
 	  len = TYPE_LENGTH (type); 
 	  localstr = alloca (len + 1);
-	  strncpy (localstr, addr, len);
+	  strncpy (localstr, straddr, len);
 	  localstr[len] = '\0'; 
 	  fprintf_filtered (stream, "'%s'", localstr);
 	}
@@ -637,10 +638,10 @@ f_val_print (type, valaddr, address, stream, format, deref_ref, recurse,
 	 bytes for the the literal complex number are stored   
 	 at the address pointed to by valaddr */ 
       
-      if (TYPE_LENGTH(type) == 32)
-	error("Cannot currently print out complex*32 literals");
+      if (TYPE_LENGTH (type) == 32)
+	error ("Cannot currently print out complex*32 literals");
       
-      /* First deref. valaddr  */ 
+      /* First dereference valaddr.  */ 
       
       addr = * (CORE_ADDR *) valaddr; 
       
@@ -733,7 +734,6 @@ info_common_command (comname, from_tty)
   struct frame_info *fi;
   register char *funname = 0;
   struct symbol *func;
-  char *cmd; 
   
   /* We have been told to display the contents of F77 COMMON 
      block supposedly visible in this function.  Let us 
@@ -825,7 +825,6 @@ there_is_a_visible_common_named (comname)
      char *comname;
 {
   SAVED_F77_COMMON_PTR  the_common; 
-  COMMON_ENTRY_PTR entry; 
   struct frame_info *fi;
   register char *funname = 0;
   struct symbol *func;