Patches to improve Fortran support

[David Lecomber]

I have two patches that are fairly useful to basic Fortran usage
for gdb-5.2 and gdb-5.3

Problem 1: Fortran array access problems..  Presently gdb allocates an
entire copy of the array and then fills it, before looking for the
required value.  This patch changes the behaviour to be more like the
C code and just allocates and copies the value required..

This solves a pretty major problem where an array is passed as a
parameter to a function with an underspecified dimension (ie. real
(10:*) ) because the * is translated to '-1' which then completely
screws up the allocation of memory..  This previously would mean that
you couldn't access data in a function where the array was passed like
this; it also eliminates the SEG faults caused when it previously
tried to allocate a negative amount of memory (ie. sizeof(real) * 10 *
-1)...

Problem 2: printing an array prints too many elements for
multi-dimensional arrays.  This patch limits the number of elements
printed to the same number that a single-dimensioned array prints.
NB. similar patch required for C, but this is less frequently used.


David
-------------- next part --------------
*** values.c	Tue Jan 29 03:08:26 2002
--- values.c	Thu Oct 17 12:21:26 2002
*************** allocate_value (struct type *type)
*** 81,88 ****
  {
    struct value *val;
    struct type *atype = check_typedef (type);
! 
!   val = (struct value *) xmalloc (sizeof (struct value) + TYPE_LENGTH (atype));
    VALUE_NEXT (val) = all_values;
    all_values = val;
    VALUE_TYPE (val) = type;
--- 81,93 ----
  {
    struct value *val;
    struct type *atype = check_typedef (type);
!   if (((int) TYPE_LENGTH(atype)) < 0) {
!     				/* a silly fortran problem - the
! 				   unspecified array dimension
! 				   issue.. */
!     val = (struct value *) xmalloc (sizeof (struct value) - TYPE_LENGTH (atype));}
!   else {
!     val = (struct value *) xmalloc (sizeof (struct value) + TYPE_LENGTH (atype));}
    VALUE_NEXT (val) = all_values;
    all_values = val;
    VALUE_TYPE (val) = type;
-------------- next part --------------
*** f-valprint.c	Wed Mar  7 02:57:08 2001
--- f-valprint.c	Mon Oct  7 10:22:57 2002
*************** static void f77_print_array (struct type
*** 46,52 ****
  			     enum val_prettyprint);
  static void f77_print_array_1 (int, int, struct type *, char *,
  			       CORE_ADDR, struct ui_file *, int, int, int,
! 			       enum val_prettyprint);
  static void f77_create_arrayprint_offset_tbl (struct type *,
  					      struct ui_file *);
  static void f77_get_dynamic_length_of_aggregate (struct type *);
--- 46,53 ----
  			     enum val_prettyprint);
  static void f77_print_array_1 (int, int, struct type *, char *,
  			       CORE_ADDR, struct ui_file *, int, int, int,
! 			       enum val_prettyprint,
! 			       int *elts);
  static void f77_create_arrayprint_offset_tbl (struct type *,
  					      struct ui_file *);
  static void f77_get_dynamic_length_of_aggregate (struct type *);
*************** f77_create_arrayprint_offset_tbl (struct
*** 270,300 ****
      }
  }
  
  /* Actual function which prints out F77 arrays, Valaddr == address in 
     the superior.  Address == the address in the inferior.  */
- 
  static void
  f77_print_array_1 (int nss, int ndimensions, struct type *type, char *valaddr,
  		   CORE_ADDR address, struct ui_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),
--- 271,306 ----
      }
  }
  
+ 
+ 
  /* Actual function which prints out F77 arrays, Valaddr == address in 
     the superior.  Address == the address in the inferior.  */
  static void
  f77_print_array_1 (int nss, int ndimensions, struct type *type, char *valaddr,
  		   CORE_ADDR address, struct ui_file *stream, int format,
! 		   int deref_ref, int recurse, enum val_prettyprint pretty,
! 		   int *elts)
  {
    int i;
  
    if (nss != ndimensions)
      {
!       for (i = 0; i < F77_DIM_SIZE (nss)  && *elts < print_max; 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, elts);
  	  fprintf_filtered (stream, ") ");
  	}
+       if (*elts >= print_max && i < F77_DIM_SIZE (nss)) {
+ 	fprintf_filtered (stream, "...");
+       }
      }
    else
      {
!       for (i = 0; (i < F77_DIM_SIZE (nss) && (*elts) < print_max); i++ , (*elts)++)
  	{
  	  val_print (TYPE_TARGET_TYPE (type),
  		     valaddr + i * F77_DIM_OFFSET (ndimensions),
*************** f77_print_array_1 (int nss, int ndimensi
*** 305,311 ****
  	  if (i != (F77_DIM_SIZE (nss) - 1))
  	    fprintf_filtered (stream, ", ");
  
! 	  if (i == print_max - 1)
  	    fprintf_filtered (stream, "...");
  	}
      }
--- 311,317 ----
  	  if (i != (F77_DIM_SIZE (nss) - 1))
  	    fprintf_filtered (stream, ", ");
  
! 	  if (( *elts) > print_max - 1)
  	    fprintf_filtered (stream, "...");
  	}
      }
*************** f77_print_array (struct type *type, char
*** 320,325 ****
--- 326,332 ----
  		 enum val_prettyprint pretty)
  {
    int ndimensions;
+   int elts = 0;
  
    ndimensions = calc_f77_array_dims (type);
  
*************** f77_print_array (struct type *type, char
*** 334,340 ****
    f77_create_arrayprint_offset_tbl (type, stream);
  
    f77_print_array_1 (1, ndimensions, type, valaddr, address, stream, format,
! 		     deref_ref, recurse, pretty);
  }
  
  
--- 341,347 ----
    f77_create_arrayprint_offset_tbl (type, stream);
  
    f77_print_array_1 (1, ndimensions, type, valaddr, address, stream, format,
! 		     deref_ref, recurse, pretty, &elts);
  }