Re: Patches to improve Fortran support

Re: Patches to improve Fortran support

[Michael Elizabeth Chastain]

Hi David,

> 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 is great, we have a longstanding PR on this:

  http://sources.redhat.com/cgi-bin/gnatsweb.pl?cmd=view&database=gdb&pr=3
  gdb segfaults associated with FORTRAN (g77) array arguments

I can review this patch later this week (Wednesday or Thursday).
Someone else might be able to get to it before then.

Do you have a copyright assignment on file with the Free Software
Foundation?

Andrew C, do you think that this patch is big enough that an
assignment is needed?

Michael C

Patches to improve Fortran support

[David Lecomber]

[-- Attachment #1: Type: text/plain, Size: 416 bytes --]

I have attached one of the wrong patch files to my email of Jan 13.

The first attached patch only cured the tendency of gdb to allocate -ve large
amounts of memory, which was my first attempt at curing the fortran array problem.
That was more curing the symptom than the cause, and doesn't work fully anyway..

The new attachment is the fix to the source of the problem.  Apologies for the 
confusion.

Cheers
David

[-- Attachment #2: gdb.array-ptr-patch --]
[-- Type: text/plain, Size: 1291 bytes --]

*** ../../TMP/gdb-5.3/gdb/eval.c	Sun Dec 15 22:29:59 2002
--- eval.c	Sun Dec 15 22:28:41 2002
*************** evaluate_subexp_standard (struct type *e
*** 1383,1392 ****
  	  offset_item =
  	    array_size_array[i] * offset_item + subscript_array[i];
  
- 	/* Construct a value node with the value of the offset */
- 
- 	arg2 = value_from_longest (builtin_type_f_integer, offset_item);
- 
  	/* Let us now play a dirty trick: we will take arg1 
  	   which is a value node pointing to the topmost level
  	   of the multidimensional array-set and pretend
--- 1383,1388 ----
*************** evaluate_subexp_standard (struct type *e
*** 1395,1401 ****
  	   returns the correct type value */
  
  	VALUE_TYPE (arg1) = tmp_type;
! 	return value_ind (value_add (value_coerce_array (arg1), arg2));
        }
  
      case BINOP_LOGICAL_AND:
--- 1391,1405 ----
  	   returns the correct type value */
  	
  	VALUE_TYPE (arg1) = tmp_type;
! 
! 	f77_get_dynamic_lowerbound (tmp_type, &lower);
! 
! 	/* Construct a value node with the value of the offset */
! 	/* lower will get subtracted off in value_subscript, hence add it here */
! 
! 	arg2 = value_from_longest (builtin_type_f_integer, offset_item + lower);
! 
! 	return value_subscript(arg1, arg2);
        }
  
      case BINOP_LOGICAL_AND:

Patches to improve Fortran support

[David Lecomber]

[-- Attachment #1: Type: text/plain, Size: 1111 bytes --]

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

[-- Attachment #2: gdb.array-arg-expression-eval-patch --]
[-- Type: text/plain, Size: 885 bytes --]

*** 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;

[-- Attachment #3: gdb.huge-array-patch --]
[-- Type: text/plain, Size: 4228 bytes --]

*** 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);
  }
  \f
  
--- 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);
  }
  \f