[04/11] Fortran dynamic arrays support: Dynamic TYPE_LENGTH

[Jan Kratochvil <jan dot kratochvil at redhat dot com>]

Hi,

with dynamic DW_AT_lower_bound / DW_AT_upper_bound the macro TYPE_LENGTH
requires to be evaluated dynamically for the specific variable.
TYPE_LENGTH_GET_WITH_ADDRESS should be used instead of TYPE_LENGTH where
possible.  TYPE_LENGTH could be deprecated.


Regards,
Jan

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

	* gdbtypes.c (type_length_get_with_address_core)
	(type_length_get_with_address): New functions.
	* gdbtypes.h (type_length_get_with_address): New prototype.
	* value.c (allocate_value): Rename to ...
	(allocate_value_with_length): ... here and add the LENGTH parameter.
	Update the function comment.  Replace the TYPE_LENGTH detection with
	the supplied LENGTH parameter.
	(allocate_value): New function.
	* value.h (allocate_value_with_length): New prototype.
	* valops.c (value_fetch_lazy): Replace the call to TYPE_LENGTH with the
	call to TYPE_LENGTH_GET_WITH_ADDRESS.

Index: sources/gdb/gdbtypes.c
===================================================================
--- sources.orig/gdb/gdbtypes.c	2007-11-16 02:48:21.000000000 +0100
+++ sources/gdb/gdbtypes.c	2007-11-16 02:53:22.000000000 +0100
@@ -827,6 +827,49 @@ create_array_type (struct type *result_t
   return (result_type);
 }
 
+/* For FULL_SPAN 1 we return stride * count, for inner array elements.
+   For FULL_SPAN 0 we have the cut the last element's length as the subwindow
+   of an array emulated by larger stride may easily exceed by its span the
+   original array end.  */
+
+static CORE_ADDR
+type_length_get_with_address_core (struct type *type, CORE_ADDR address,
+				   int full_span)
+{
+  struct type *range_type;
+  int count;
+  CORE_ADDR byte_stride = 0;	/* `= 0' for a false GCC warning.  */
+  CORE_ADDR element_size;
+
+  if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
+    return TYPE_LENGTH (type);
+
+  range_type = TYPE_INDEX_TYPE (type);
+  count = 1 + TYPE_HIGH_BOUND (range_type) - TYPE_LOW_BOUND (range_type);
+  if (count < 0)
+    warning (_("Object count %d < 0"), count);
+  if (count <= 0)
+    return 0;
+  if (full_span || count > 1)
+    {
+      byte_stride = type_length_get_with_address_core
+		      (TYPE_TARGET_TYPE (type), address, 1);
+    }
+  if (full_span)
+    return count * byte_stride;
+  element_size = type_length_get_with_address (TYPE_TARGET_TYPE (type),
+					       address);
+  return (count - 1) * byte_stride + element_size;
+}
+
+CORE_ADDR
+type_length_get_with_address (struct type *type, CORE_ADDR address)
+{
+  struct type *atype = check_typedef (type);
+
+  return type_length_get_with_address_core (atype, address, 0);
+}
+
 /* Create a string type using either a blank type supplied in
    RESULT_TYPE, or creating a new type.  String types are similar
    enough to array of char types that we can use create_array_type to
Index: sources/gdb/gdbtypes.h
===================================================================
--- sources.orig/gdb/gdbtypes.h	2007-11-16 02:48:22.000000000 +0100
+++ sources/gdb/gdbtypes.h	2007-11-16 02:53:22.000000000 +0100
@@ -812,6 +812,9 @@ extern void allocate_cplus_struct_type (
    so you only have to call check_typedef once.  Since allocate_value
    calls check_typedef, TYPE_LENGTH (VALUE_TYPE (X)) is safe.  */
 #define TYPE_LENGTH(thistype) (thistype)->length
+/* TYPE_LENGTH_GET_WITH_ADDRESS resolves dynamic array boundaries.  */
+extern CORE_ADDR type_length_get_with_address (struct type *type,
+					       CORE_ADDR address);
 #define TYPE_OBJFILE(thistype) TYPE_MAIN_TYPE(thistype)->objfile
 #define TYPE_FLAGS(thistype) TYPE_MAIN_TYPE(thistype)->flags
 /* Note that TYPE_CODE can be TYPE_CODE_TYPEDEF, so if you want the real
Index: sources/gdb/value.c
===================================================================
--- sources.orig/gdb/value.c	2007-11-16 02:48:25.000000000 +0100
+++ sources/gdb/value.c	2007-11-16 02:48:40.000000000 +0100
@@ -209,15 +209,15 @@ static int value_history_count;	/* Abs n
 
 static struct value *all_values;
 
-/* Allocate a  value  that has the correct length for type TYPE.  */
+/* Allocate a value that has the length LENGTH for type TYPE.  Be sure to call
+   CHECK_TYPEDEF on TYPE before querying its TYPE_LENGTH.  */
 
 struct value *
-allocate_value (struct type *type)
+allocate_value_with_length (struct type *type, CORE_ADDR length)
 {
   struct value *val;
-  struct type *atype = check_typedef (type);
 
-  val = (struct value *) xzalloc (sizeof (struct value) + TYPE_LENGTH (atype));
+  val = (struct value *) xzalloc (sizeof (struct value) + length);
   val->next = all_values;
   all_values = val;
   val->type = type;
@@ -238,6 +238,14 @@ allocate_value (struct type *type)
   return val;
 }
 
+struct value *
+allocate_value (struct type *type)
+{
+  struct type *atype = check_typedef (type);
+
+  return allocate_value_with_length (type, TYPE_LENGTH (atype));
+}
+
 /* Allocate a  value  that has the correct length
    for COUNT repetitions type TYPE.  */
 
Index: sources/gdb/value.h
===================================================================
--- sources.orig/gdb/value.h	2007-11-16 02:48:39.000000000 +0100
+++ sources/gdb/value.h	2007-11-16 02:48:40.000000000 +0100
@@ -310,6 +310,9 @@ extern struct value *read_var_value (str
 extern struct value *locate_var_value (struct symbol *var,
 				       struct frame_info *frame);
 
+extern struct value *allocate_value_with_length (struct type *type,
+						 CORE_ADDR length);
+
 extern struct value *allocate_value (struct type *type);
 
 extern struct value *allocate_repeat_value (struct type *type, int count);
Index: sources/gdb/valops.c
===================================================================
--- sources.orig/gdb/valops.c	2007-11-16 02:48:39.000000000 +0100
+++ sources/gdb/valops.c	2007-11-16 02:54:48.000000000 +0100
@@ -524,7 +524,8 @@ value_fetch_lazy (struct value *val)
 
   if (LA_VALUE_ADDRESS_GET (val, &addr))
     {
-      int length = TYPE_LENGTH (value_enclosing_type (val));
+      int length = type_length_get_with_address (value_enclosing_type (val),
+						 VALUE_ADDRESS (val));
 
       if (length)
         {