This is the mail archive of the gdb-patches@sourceware.org mailing list for the GDB project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[09/11] Fortran dynamic arrays support: Dynamic array bounds for Fortran


Hi,

the dynamic bounds part for Fortran, it could be even a single patch.


Regards,
Jan
2007-11-16  Jan Kratochvil  <jan.kratochvil@redhat.com>

	* eval.c (evaluate_subexp_standard): New variables BYTE_STRIDE_ARRAY,
	OFFSET_BYTE and ELEMENT_SIZE.  Calculate the array offsets using the
	TYPE_ARRAY_BYTE_STRIDE_VALUE_WITH_ADDRESS value, if provided.
	* f-lang.h (f77_get_dynamic_upperbound, f77_get_dynamic_lowerbound):
	Add the parameter ADDRESS to the prototypes.
	* f-typeprint.c (f_type_print_varspec_suffix): Likewise.
	(f_print_type_with_address): Add the ADDRESS parameter to the call of
	F_TYPE_PRINT_VARSPEC_SUFFIX.
	(f_type_print_varspec_prefix): Add the ADDRESS parameter.  Update all
	its callers.
	* f-valprint.c (f77_create_arrayprint_offset_tbl): Add the ADDRESS
	parameter to the prototype.
	(F77_DIM_SIZE): Rename to ...
	(F77_DIM_COUNT): ... here.  Update all its uses.
	(F77_DIM_OFFSET): Rename to ...
	(F77_DIM_BYTE_STRIDE): ... here.  Update all its uses.
	(f77_get_dynamic_lowerbound): Add the ADDRESS parameter.  Update all
	its callers.  Add a function comment.  Replace the call to
	TYPE_ARRAY_LOWER_BOUND_VALUE with the call to
	TYPE_ARRAY_LOWER_BOUND_VALUE_WITH_ADDRESS.
	(f77_get_dynamic_upperbound): Add the ADDRESS parameter.  Update all
	its callers.  Add a function comment.  Replace the call to
	TYPE_ARRAY_UPPER_BOUND_VALUE with the call to
	TYPE_ARRAY_UPPER_BOUND_VALUE_WITH_ADDRESS.
	(f77_create_arrayprint_offset_tbl): Add the ADDRESS parameter.  Update
	all its callers.  Update the F77_DIM_BYTE_STRIDE calculation to use the
	TYPE_ARRAY_BYTE_STRIDE_VALUE_WITH_ADDRESS value, if provided.

Index: sources/gdb/eval.c
===================================================================
--- sources.orig/gdb/eval.c	2007-11-15 23:59:43.000000000 +0100
+++ sources/gdb/eval.c	2007-11-16 00:23:42.000000000 +0100
@@ -1615,9 +1615,12 @@ evaluate_subexp_standard (struct type *e
       {
 	int subscript_array[MAX_FORTRAN_DIMS];
 	int array_size_array[MAX_FORTRAN_DIMS];
+	int byte_stride_array[MAX_FORTRAN_DIMS];
 	int ndimensions = 1, i;
 	struct type *tmp_type;
 	int offset_item;	/* The array offset where the item lives */
+	CORE_ADDR offset_byte;	/* byte_stride based offset  */
+	unsigned element_size;
 
 	if (nargs > MAX_FORTRAN_DIMS)
 	  error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
@@ -1646,14 +1649,20 @@ evaluate_subexp_standard (struct type *e
 	/* Internal type of array is arranged right to left */
 	for (i = 0; i < nargs; i++)
 	  {
-	    retcode = f77_get_dynamic_upperbound (tmp_type, &upper);
+	    retcode = f77_get_dynamic_upperbound (tmp_type,
+						  VALUE_ADDRESS (arg1), &upper);
 	    if (retcode == BOUND_FETCH_ERROR)
 	      error (_("Cannot obtain dynamic upper bound"));
 
-	    retcode = f77_get_dynamic_lowerbound (tmp_type, &lower);
+	    retcode = f77_get_dynamic_lowerbound (tmp_type,
+						  VALUE_ADDRESS (arg1), &lower);
 	    if (retcode == BOUND_FETCH_ERROR)
 	      error (_("Cannot obtain dynamic lower bound"));
 
+	    byte_stride_array[nargs - i - 1] =
+	      TYPE_ARRAY_BYTE_STRIDE_VALUE_WITH_ADDRESS (tmp_type,
+							 VALUE_ADDRESS (arg1));
+
 	    array_size_array[nargs - i - 1] = upper - lower + 1;
 
 	    /* Zero-normalize subscripts so that offsetting will work. */
@@ -1674,11 +1683,22 @@ evaluate_subexp_standard (struct type *e
 
 	/* Now let us calculate the offset for this item */
 
-	offset_item = subscript_array[ndimensions - 1];
+	offset_item = 0;
+	offset_byte = 0;
+
+	for (i = ndimensions - 1; i >= 0; --i)
+	  {
+	    offset_item *= array_size_array[i];
+	    if (byte_stride_array[i] == 0)
+	      offset_item += subscript_array[i];
+	    else
+	      offset_byte += subscript_array[i] * byte_stride_array[i];
+	  }
 
-	for (i = ndimensions - 1; i > 0; --i)
-	  offset_item =
-	    array_size_array[i - 1] * offset_item + subscript_array[i - 1];
+	element_size = TYPE_LENGTH (TYPE_TARGET_TYPE (tmp_type));
+	if (offset_byte % element_size != 0)
+	  warning (_("Fortran array stride not divisible by the element size"));
+	offset_item += offset_byte / element_size;
 
 	/* Construct a value node with the value of the offset */
 
Index: sources/gdb/f-lang.h
===================================================================
--- sources.orig/gdb/f-lang.h	2007-11-16 00:00:16.000000000 +0100
+++ sources/gdb/f-lang.h	2007-11-16 00:23:42.000000000 +0100
@@ -97,9 +97,9 @@ extern SAVED_F77_COMMON_PTR find_common_
 extern char *real_main_name;	/* Name of main function */
 extern int real_main_c_value;	/* C_value field of main function */
 
-extern int f77_get_dynamic_upperbound (struct type *, int *);
+extern int f77_get_dynamic_upperbound (struct type *, CORE_ADDR, int *);
 
-extern int f77_get_dynamic_lowerbound (struct type *, int *);
+extern int f77_get_dynamic_lowerbound (struct type *, CORE_ADDR, int *);
 
 extern void f77_get_dynamic_array_length (struct type *);
 
Index: sources/gdb/f-typeprint.c
===================================================================
--- sources.orig/gdb/f-typeprint.c	2007-11-16 00:00:16.000000000 +0100
+++ sources/gdb/f-typeprint.c	2007-11-16 00:23:42.000000000 +0100
@@ -42,8 +42,8 @@ static void f_type_print_args (struct ty
 static void print_equivalent_f77_float_type (int level, struct type *,
 					     struct ui_file *);
 
-static void f_type_print_varspec_suffix (struct type *, struct ui_file *,
-					 int, int, int);
+static void f_type_print_varspec_suffix (struct type *, CORE_ADDR,
+					 struct ui_file *, int, int, int);
 
 void f_type_print_varspec_prefix (struct type *, struct ui_file *,
 				  int, int);
@@ -82,7 +82,7 @@ f_print_type_with_address (struct type *
      so don't print an additional pair of ()'s */
 
   demangled_args = varstring[strlen (varstring) - 1] == ')';
-  f_type_print_varspec_suffix (type, stream, show, 0, demangled_args);
+  f_type_print_varspec_suffix (type, address, stream, show, 0, demangled_args);
 }
 
 /* Print any asterisks or open-parentheses needed before the
@@ -150,8 +150,9 @@ f_type_print_varspec_prefix (struct type
    Args work like c_type_print_varspec_prefix.  */
 
 static void
-f_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
-			     int show, int passed_a_ptr, int demangled_args)
+f_type_print_varspec_suffix (struct type *type, CORE_ADDR address,
+			     struct ui_file *stream, int show, int passed_a_ptr,
+			     int demangled_args)
 {
   int upper_bound, lower_bound;
   int lower_bound_was_default = 0;
@@ -175,9 +176,10 @@ f_type_print_varspec_suffix (struct type
 	fprintf_filtered (stream, "(");
 
       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
-	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0);
+	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), address, stream,
+				     0, 0, 0);
 
-      retcode = f77_get_dynamic_lowerbound (type, &lower_bound);
+      retcode = f77_get_dynamic_lowerbound (type, address, &lower_bound);
 
       lower_bound_was_default = 0;
 
@@ -200,7 +202,7 @@ f_type_print_varspec_suffix (struct type
 	fprintf_filtered (stream, "*");
       else
 	{
-	  retcode = f77_get_dynamic_upperbound (type, &upper_bound);
+	  retcode = f77_get_dynamic_upperbound (type, address, &upper_bound);
 
 	  if (retcode == BOUND_FETCH_ERROR)
 	    fprintf_filtered (stream, "???");
@@ -209,7 +211,8 @@ f_type_print_varspec_suffix (struct type
 	}
 
       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
-	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0);
+	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), address, stream,
+				     0, 0, 0);
       if (arrayprint_recurse_level == 1)
 	fprintf_filtered (stream, ")");
       else
@@ -219,12 +222,13 @@ f_type_print_varspec_suffix (struct type
 
     case TYPE_CODE_PTR:
     case TYPE_CODE_REF:
-      f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0);
+      f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), address, stream, 0,
+				   1, 0);
       fprintf_filtered (stream, ")");
       break;
 
     case TYPE_CODE_FUNC:
-      f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
+      f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), address, stream, 0,
 				   passed_a_ptr, 0);
       if (passed_a_ptr)
 	fprintf_filtered (stream, ")");
@@ -381,7 +385,7 @@ f_type_print_base (struct type *type, st
 	fprintfi_filtered (level, stream, "character*(*)");
       else
 	{
-	  retcode = f77_get_dynamic_upperbound (type, &upper_bound);
+	  retcode = f77_get_dynamic_upperbound (type, 0, &upper_bound);
 
 	  if (retcode == BOUND_FETCH_ERROR)
 	    fprintf_filtered (stream, "character*???");
Index: sources/gdb/f-valprint.c
===================================================================
--- sources.orig/gdb/f-valprint.c	2007-11-15 23:59:43.000000000 +0100
+++ sources/gdb/f-valprint.c	2007-11-16 00:25:27.000000000 +0100
@@ -42,8 +42,8 @@ static int there_is_a_visible_common_nam
 extern void _initialize_f_valprint (void);
 static void info_common_command (char *, int);
 static void list_all_visible_commons (char *);
-static void f77_create_arrayprint_offset_tbl (struct type *,
-					      struct ui_file *);
+static void f77_create_arrayprint_offset_tbl (struct type *, struct ui_file *,
+					      CORE_ADDR address);
 static void f77_get_dynamic_length_of_aggregate (struct type *);
 
 int f77_array_offset_tbl[MAX_FORTRAN_DIMS + 1][2];
@@ -54,14 +54,17 @@ int f77_array_offset_tbl[MAX_FORTRAN_DIM
 /* 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])
+#define F77_DIM_COUNT(n) (f77_array_offset_tbl[n][1])
 
-/* The following gives us the offset for row n where n is 1-based. */
+/* The following gives us the element size for row n where n is 1-based. */
 
-#define F77_DIM_OFFSET(n) (f77_array_offset_tbl[n][0])
+#define F77_DIM_BYTE_STRIDE(n) (f77_array_offset_tbl[n][0])
+
+/* ADDRESS is the value address at the inferior.  */
 
 int
-f77_get_dynamic_lowerbound (struct type *type, int *lower_bound)
+f77_get_dynamic_lowerbound (struct type *type, CORE_ADDR address,
+			    int *lower_bound)
 {
   struct frame_info *frame;
   CORE_ADDR current_frame_addr;
@@ -87,7 +90,7 @@ f77_get_dynamic_lowerbound (struct type 
       break;
 
     case BOUND_SIMPLE:
-      *lower_bound = TYPE_ARRAY_LOWER_BOUND_VALUE (type);
+      *lower_bound = TYPE_ARRAY_LOWER_BOUND_VALUE_WITH_ADDRESS (type, address);
       break;
 
     case BOUND_CANNOT_BE_DETERMINED:
@@ -121,8 +124,11 @@ f77_get_dynamic_lowerbound (struct type 
   return BOUND_FETCH_OK;
 }
 
+/* ADDRESS is the value address at the inferior.  */
+
 int
-f77_get_dynamic_upperbound (struct type *type, int *upper_bound)
+f77_get_dynamic_upperbound (struct type *type, CORE_ADDR address,
+			    int *upper_bound)
 {
   struct frame_info *frame;
   CORE_ADDR current_frame_addr = 0;
@@ -148,7 +154,7 @@ f77_get_dynamic_upperbound (struct type 
       break;
 
     case BOUND_SIMPLE:
-      *upper_bound = TYPE_ARRAY_UPPER_BOUND_VALUE (type);
+      *upper_bound = TYPE_ARRAY_UPPER_BOUND_VALUE_WITH_ADDRESS (type, address);
       break;
 
     case BOUND_CANNOT_BE_DETERMINED:
@@ -157,7 +163,7 @@ f77_get_dynamic_upperbound (struct type 
          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, 0, upper_bound);
       break;
 
     case BOUND_BY_REF_ON_STACK:
@@ -210,11 +216,11 @@ f77_get_dynamic_length_of_aggregate (str
     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);
+  retcode = f77_get_dynamic_lowerbound (type, 0, &lower_bound);
   if (retcode == BOUND_FETCH_ERROR)
     error (_("Cannot obtain valid array lower bound"));
 
-  retcode = f77_get_dynamic_upperbound (type, &upper_bound);
+  retcode = f77_get_dynamic_upperbound (type, 0, &upper_bound);
   if (retcode == BOUND_FETCH_ERROR)
     error (_("Cannot obtain valid array upper bound"));
 
@@ -225,10 +231,11 @@ f77_get_dynamic_length_of_aggregate (str
 }
 
 /* Function that sets up the array offset,size table for the array 
-   type "type".  */
+   type "type".  ADDRESS is the value address at the inferior.  */
 
 static void
-f77_create_arrayprint_offset_tbl (struct type *type, struct ui_file *stream)
+f77_create_arrayprint_offset_tbl (struct type *type, struct ui_file *stream,
+				  CORE_ADDR address)
 {
   struct type *tmp_type;
   int eltlen;
@@ -242,32 +249,37 @@ f77_create_arrayprint_offset_tbl (struct
       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);
+      retcode = f77_get_dynamic_upperbound (tmp_type, address, &upper);
       if (retcode == BOUND_FETCH_ERROR)
 	error (_("Cannot obtain dynamic upper bound"));
 
-      retcode = f77_get_dynamic_lowerbound (tmp_type, &lower);
+      retcode = f77_get_dynamic_lowerbound (tmp_type, address, &lower);
       if (retcode == BOUND_FETCH_ERROR)
 	error (_("Cannot obtain dynamic lower bound"));
 
-      F77_DIM_SIZE (ndimen) = upper - lower + 1;
+      F77_DIM_COUNT (ndimen) = upper - lower + 1;
+
+      F77_DIM_BYTE_STRIDE (ndimen) =
+        TYPE_ARRAY_BYTE_STRIDE_VALUE_WITH_ADDRESS (tmp_type, address);
 
       tmp_type = TYPE_TARGET_TYPE (tmp_type);
       ndimen++;
     }
 
-  /* Now we multiply eltlen by all the offsets, so that later we 
+  /* Now we multiply eltlen by all the BYTE_STRIDEs, 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 
+     know an eltlen 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;
+  if (F77_DIM_BYTE_STRIDE (ndimen) == 0)
+    F77_DIM_BYTE_STRIDE (ndimen) = eltlen;
   while (--ndimen > 0)
     {
-      eltlen *= F77_DIM_SIZE (ndimen + 1);
-      F77_DIM_OFFSET (ndimen) = eltlen;
+      eltlen *= F77_DIM_COUNT (ndimen + 1);
+      if (F77_DIM_BYTE_STRIDE (ndimen) == 0)
+	F77_DIM_BYTE_STRIDE (ndimen) = eltlen;
     }
 }
 
@@ -287,33 +299,33 @@ f77_print_array_1 (int nss, int ndimensi
 
   if (nss != ndimensions)
     {
-      for (i = 0; (i < F77_DIM_SIZE (nss) && (*elts) < print_max); i++)
+      for (i = 0; (i < F77_DIM_COUNT (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),
+			     valaddr + i * F77_DIM_BYTE_STRIDE (nss),
+			     address + i * F77_DIM_BYTE_STRIDE (nss),
 			     stream, format, deref_ref, recurse, pretty, elts);
 	  fprintf_filtered (stream, ") ");
 	}
-      if (*elts >= print_max && i < F77_DIM_SIZE (nss)) 
+      if (*elts >= print_max && i < F77_DIM_COUNT (nss))
 	fprintf_filtered (stream, "...");
     }
   else
     {
-      for (i = 0; i < F77_DIM_SIZE (nss) && (*elts) < print_max; 
+      for (i = 0; i < F77_DIM_COUNT (nss) && (*elts) < print_max;
 	   i++, (*elts)++)
 	{
 	  val_print (TYPE_TARGET_TYPE (type),
-		     valaddr + i * F77_DIM_OFFSET (ndimensions),
+		     valaddr + i * F77_DIM_BYTE_STRIDE (ndimensions),
 		     0,
-		     address + i * F77_DIM_OFFSET (ndimensions),
+		     address + i * F77_DIM_BYTE_STRIDE (ndimensions),
 		     stream, format, deref_ref, recurse, pretty);
 
-	  if (i != (F77_DIM_SIZE (nss) - 1))
+	  if (i != (F77_DIM_COUNT (nss) - 1))
 	    fprintf_filtered (stream, ", ");
 
-	  if ((*elts == print_max - 1) && (i != (F77_DIM_SIZE (nss) - 1)))
+	  if ((*elts == print_max - 1) && (i != (F77_DIM_COUNT (nss) - 1)))
 	    fprintf_filtered (stream, "...");
 	}
     }
@@ -341,7 +353,7 @@ f77_print_array (struct type *type, cons
      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_create_arrayprint_offset_tbl (type, stream, address);
 
   f77_print_array_1 (1, ndimensions, type, valaddr, address, stream, format,
 		     deref_ref, recurse, pretty, &elts);

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]