This is the mail archive of the
gdb-patches@sourceware.org
mailing list for the GDB project.
[10/11] Fortran dynamic arrays support: Fortran array attributes
- From: Jan Kratochvil <jan dot kratochvil at redhat dot com>
- To: gdb-patches at sourceware dot org
- Date: Fri, 16 Nov 2007 04:20:45 +0100
- Subject: [10/11] Fortran dynamic arrays support: Fortran array attributes
Hi,
final support for the tags DW_AT_data_location, DW_AT_allocated and
DW_AT_associated on top of the implemented functions.
Regards,
Jan
2007-11-16 Jan Kratochvil <jan.kratochvil@redhat.com>
* dwarf2read.c: Include "f-lang.h".
(read_array_type): New variables FORTRAN_ARRAY, FORTRAN_ARRAY_ZERO and
FORTRAN_ARRAY_POINTER. Set the FORTRAN_ARRAY content. Fill in
TYPE_FORTRAN_ARRAY for all the range types and the array types.
* f-lang.h (f_type_object_valid_query, f_type_object_valid_to_stream)
(f_type_object_valid_error, struct fortran_array_type)
(TYPE_FORTRAN_ARRAY_DATA_LOCATION, TYPE_FORTRAN_ARRAY_ALLOCATED)
(TYPE_FORTRAN_ARRAY_ASSOCIATED): New.
* f-typeprint.c: Include "dwarf2expr.h"
(f_type_object_valid_query, f_type_object_valid_to_stream)
(f_type_object_valid_error): New functions.
(f_print_type_with_address): Call F_TYPE_OBJECT_VALID_TO_STREAM.
* f-valprint.c (f77_get_dynamic_lowerbound, f77_get_dynamic_upperbound):
Call F_TYPE_OBJECT_VALID_ERROR.
(f_val_print): Call F_TYPE_OBJECT_VALID_TO_STREAM.
* gdbtypes.h (struct main_type): New field TYPE_SPECIFIC.FORTRAN_ARRAY.
(TYPE_FORTRAN_ARRAY): New macro.
* f-lang.c: Include "dwarf2expr.h".
(f_value_address_get): New function.
(f_language_defn): Replace the value DEFAULT_VALUE_ADDRESS_GET with
F_VALUE_ADDRESS_GET.
* Makefile.in: Update dependencies.
Index: sources/gdb/dwarf2read.c
===================================================================
--- sources.orig/gdb/dwarf2read.c 2007-11-16 00:36:19.000000000 +0100
+++ sources/gdb/dwarf2read.c 2007-11-16 00:37:36.000000000 +0100
@@ -47,6 +47,7 @@
#include "gdbcmd.h"
#include "gdbcore.h"
#include "exceptions.h"
+#include "f-lang.h"
#include <fcntl.h>
#include "gdb_string.h"
@@ -4262,6 +4263,10 @@ read_array_type (struct die_info *die, s
int ndim = 0;
struct cleanup *back_to;
char *name;
+ struct fortran_array_type fortran_array;
+ /* Used only for checking if FORTRAN_ARRAY is non-zero. */
+ static struct fortran_array_type fortran_array_zero;
+ struct fortran_array_type *fortran_array_pointer;
/* Return if we've already decoded this type. */
if (die->type)
@@ -4271,6 +4276,33 @@ read_array_type (struct die_info *die, s
element_type = die_type (die, cu);
+ /* Prepare FORTRAN_ARRAY_POINTER. It needs to be present in all the subarray
+ types and in all the range types at least for
+ TYPE_VERIFY_VALID_ARRAY_OBJECT. */
+
+ memset (&fortran_array, 0, sizeof fortran_array);
+
+ attr = dwarf2_attr (die, DW_AT_data_location, cu);
+ if (attr)
+ fortran_array.data_location = DW_BLOCK (attr);
+
+ attr = dwarf2_attr (die, DW_AT_allocated, cu);
+ if (attr)
+ fortran_array.allocated = DW_BLOCK (attr);
+
+ attr = dwarf2_attr (die, DW_AT_associated, cu);
+ if (attr)
+ fortran_array.associated = DW_BLOCK (attr);
+
+ if (memcmp (&fortran_array, &fortran_array_zero, sizeof fortran_array) == 0)
+ fortran_array_pointer = NULL;
+ else
+ {
+ fortran_array_pointer = TYPE_ALLOC (element_type,
+ sizeof *fortran_array_pointer);
+ *fortran_array_pointer = fortran_array;
+ }
+
/* Irix 6.2 native cc creates array types without children for
arrays with unspecified length. */
if (die->child == NULL)
@@ -4279,6 +4311,8 @@ read_array_type (struct die_info *die, s
range_type = create_range_type (NULL, index_type, 0, -1);
set_die_type (die, create_array_type (NULL, element_type, range_type),
cu);
+
+ TYPE_FORTRAN_ARRAY (range_type) = fortran_array_pointer;
return;
}
@@ -4319,6 +4353,8 @@ read_array_type (struct die_info *die, s
for (i = 0; i < ndim; i++)
{
type = create_array_type (NULL, type, range_types[i]);
+ TYPE_FORTRAN_ARRAY (range_types[i]) = fortran_array_pointer;
+ TYPE_FORTRAN_ARRAY (type) = fortran_array_pointer;
TYPE_ARRAY_UPPER_BOUND_TYPE (type) =
TYPE_ARRAY_UPPER_BOUND_TYPE (range_types[i]);
TYPE_ARRAY_LOWER_BOUND_TYPE (type) =
@@ -4331,6 +4367,8 @@ read_array_type (struct die_info *die, s
for (i = ndim - 1; i >= 0; i--)
{
type = create_array_type (NULL, type, range_types[i]);
+ TYPE_FORTRAN_ARRAY (range_types[i]) = fortran_array_pointer;
+ TYPE_FORTRAN_ARRAY (type) = fortran_array_pointer;
TYPE_ARRAY_UPPER_BOUND_TYPE (type) =
TYPE_ARRAY_UPPER_BOUND_TYPE (range_types[i]);
TYPE_ARRAY_LOWER_BOUND_TYPE (type) =
Index: sources/gdb/f-lang.h
===================================================================
--- sources.orig/gdb/f-lang.h 2007-11-16 00:37:34.000000000 +0100
+++ sources/gdb/f-lang.h 2007-11-16 00:37:36.000000000 +0100
@@ -28,6 +28,13 @@ extern void f_error (char *); /* Defined
extern void f_print_type_with_address (struct type *, CORE_ADDR, char *,
struct ui_file *, int, int);
+extern const char *f_type_object_valid_query (struct type *type,
+ CORE_ADDR address);
+extern const char *f_type_object_valid_to_stream (struct type *type,
+ CORE_ADDR address,
+ struct ui_file *stream);
+extern void f_type_object_valid_error (struct type *type, CORE_ADDR address);
+
extern int f_val_print (struct type *, const gdb_byte *, int, CORE_ADDR,
struct ui_file *, int, int, int,
enum val_prettyprint);
@@ -47,6 +54,32 @@ enum f90_range_type
NONE_BOUND_DEFAULT /* "(low:high)" */
};
+/* GNU Fortran specific - for TYPE_FORTRAN_ARRAY.
+ All the DWARF_BLOCK fields are passed for execution to DWARF_BLOCK_EXEC. */
+
+struct fortran_array_type
+{
+ /* For DW_AT_data_location. This entry is more appropriate for generic
+ MAIN_TYPE but we save the MAIN_TYPE size as it is in practice not present
+ for the other types. */
+ struct dwarf_block *data_location;
+
+ /* For DW_AT_allocated. */
+ struct dwarf_block *allocated;
+
+ /* For DW_AT_associated. */
+ struct dwarf_block *associated;
+};
+
+/* Be sure to check `TYPE_CODE (thistype) == TYPE_CODE_ARRAY
+ && TYPE_FORTRAN_ARRAY (thistype) != NULL'. */
+#define TYPE_FORTRAN_ARRAY_DATA_LOCATION(thistype) \
+ TYPE_FORTRAN_ARRAY (thistype)->data_location
+#define TYPE_FORTRAN_ARRAY_ALLOCATED(thistype) \
+ TYPE_FORTRAN_ARRAY (thistype)->allocated
+#define TYPE_FORTRAN_ARRAY_ASSOCIATED(thistype) \
+ TYPE_FORTRAN_ARRAY (thistype)->associated
+
struct common_entry
{
struct symbol *symbol; /* The symbol node corresponding
Index: sources/gdb/f-typeprint.c
===================================================================
--- sources.orig/gdb/f-typeprint.c 2007-11-16 00:37:34.000000000 +0100
+++ sources/gdb/f-typeprint.c 2007-11-16 00:37:36.000000000 +0100
@@ -31,6 +31,7 @@
#include "gdbcore.h"
#include "target.h"
#include "f-lang.h"
+#include "dwarf2expr.h"
#include "gdb_string.h"
#include <errno.h>
@@ -51,6 +52,51 @@ void f_type_print_varspec_prefix (struct
void f_type_print_base (struct type *, struct ui_file *, int, int);
+const char *
+f_type_object_valid_query (struct type *type, CORE_ADDR address)
+{
+ if (TYPE_CODE (type) == TYPE_CODE_ARRAY && TYPE_FORTRAN_ARRAY (type) != NULL)
+ {
+ /* DW_AT_associated has a preference over DW_AT_allocated. */
+ if (TYPE_FORTRAN_ARRAY_ASSOCIATED (type) != NULL
+ && !dwarf_block_exec (TYPE_FORTRAN_ARRAY_ASSOCIATED (type), address))
+ return N_("the array is not associated");
+
+ if (TYPE_FORTRAN_ARRAY_ALLOCATED (type) != NULL
+ && !dwarf_block_exec (TYPE_FORTRAN_ARRAY_ALLOCATED (type), address))
+ return N_("the array is not allocated");
+ }
+ return NULL;
+}
+
+const char *
+f_type_object_valid_to_stream (struct type *type, CORE_ADDR address,
+ struct ui_file *stream)
+{
+ const char *msg;
+
+ msg = f_type_object_valid_query (type, address);
+ if (msg != NULL)
+ {
+ /* Assuming the content printed to STREAM should not be localized. */
+ fprintf_filtered (stream, "<%s>", msg);
+ }
+
+ return msg;
+}
+
+void
+f_type_object_valid_error (struct type *type, CORE_ADDR address)
+{
+ const char *msg;
+
+ msg = f_type_object_valid_query (type, address);
+ if (msg != NULL)
+ {
+ error (_("Unable to access the object because %s."), _(msg));
+ }
+}
+
/* LEVEL is the depth to indent lines by. */
void
@@ -61,6 +107,9 @@ f_print_type_with_address (struct type *
enum type_code code;
int demangled_args;
+ if (f_type_object_valid_to_stream (type, address, stream) != NULL)
+ return;
+
f_type_print_base (type, stream, show, level);
code = TYPE_CODE (type);
if ((varstring != NULL && *varstring != '\0')
Index: sources/gdb/f-valprint.c
===================================================================
--- sources.orig/gdb/f-valprint.c 2007-11-16 00:37:34.000000000 +0100
+++ sources/gdb/f-valprint.c 2007-11-16 00:37:36.000000000 +0100
@@ -70,6 +70,8 @@ f77_get_dynamic_lowerbound (struct type
CORE_ADDR current_frame_addr;
CORE_ADDR ptr_to_lower_bound;
+ f_type_object_valid_error (type, address);
+
switch (TYPE_ARRAY_LOWER_BOUND_TYPE (type))
{
case BOUND_BY_VALUE_ON_STACK:
@@ -134,6 +136,8 @@ f77_get_dynamic_upperbound (struct type
CORE_ADDR current_frame_addr = 0;
CORE_ADDR ptr_to_upper_bound;
+ f_type_object_valid_error (type, address);
+
switch (TYPE_ARRAY_UPPER_BOUND_TYPE (type))
{
case BOUND_BY_VALUE_ON_STACK:
@@ -384,6 +388,9 @@ f_val_print (struct type *type, const gd
CORE_ADDR addr;
int index;
+ if (f_type_object_valid_to_stream (type, address, stream) != NULL)
+ return 0;
+
CHECK_TYPEDEF (type);
switch (TYPE_CODE (type))
{
Index: sources/gdb/gdbtypes.h
===================================================================
--- sources.orig/gdb/gdbtypes.h 2007-11-16 00:36:19.000000000 +0100
+++ sources/gdb/gdbtypes.h 2007-11-16 00:37:36.000000000 +0100
@@ -526,6 +526,10 @@ struct main_type
targets and the second is for little endian targets. */
const struct floatformat **floatformat;
+
+ /* FORTRAN_ARRAY is for TYPE_CODE_ARRAY. */
+
+ struct fortran_array_type *fortran_array;
} type_specific;
};
@@ -876,6 +880,7 @@ extern CORE_ADDR type_length_get_with_ad
#define TYPE_TYPE_SPECIFIC(thistype) TYPE_MAIN_TYPE(thistype)->type_specific
#define TYPE_CPLUS_SPECIFIC(thistype) TYPE_MAIN_TYPE(thistype)->type_specific.cplus_stuff
#define TYPE_FLOATFORMAT(thistype) TYPE_MAIN_TYPE(thistype)->type_specific.floatformat
+#define TYPE_FORTRAN_ARRAY(thistype) TYPE_MAIN_TYPE(thistype)->type_specific.fortran_array
#define TYPE_BASECLASS(thistype,index) TYPE_MAIN_TYPE(thistype)->fields[index].type
#define TYPE_N_BASECLASSES(thistype) TYPE_CPLUS_SPECIFIC(thistype)->n_baseclasses
#define TYPE_BASECLASS_NAME(thistype,index) TYPE_MAIN_TYPE(thistype)->fields[index].name
Index: sources/gdb/f-lang.c
===================================================================
--- sources.orig/gdb/f-lang.c 2007-11-16 00:34:57.000000000 +0100
+++ sources/gdb/f-lang.c 2007-11-16 00:37:36.000000000 +0100
@@ -31,6 +31,7 @@
#include "f-lang.h"
#include "valprint.h"
#include "value.h"
+#include "dwarf2expr.h"
/* Following is dubious stuff that had been in the xcoff reader. */
@@ -387,6 +388,37 @@ f_create_fundamental_type (struct objfil
}
return (type);
}
+
+static int
+f_value_address_get(struct value *val, CORE_ADDR *address_return)
+{
+ struct type *type = value_type (val);
+ CORE_ADDR address;
+
+ address = VALUE_ADDRESS (val);
+
+ if (f_type_object_valid_query (type, address) != NULL)
+ {
+ /* Do not try to evaluate DW_AT_data_location as it may even crash
+ (it would just return the value zero in the gfortran case). */
+ return 0;
+ }
+
+ /* Accelerated codepath. */
+ if (address_return == NULL)
+ return 1;
+
+ if (TYPE_CODE (type) == TYPE_CODE_ARRAY && TYPE_FORTRAN_ARRAY (type) != NULL)
+ {
+ if (TYPE_FORTRAN_ARRAY_DATA_LOCATION (type) != NULL)
+ address = dwarf_block_exec (TYPE_FORTRAN_ARRAY_DATA_LOCATION (type),
+ address);
+ }
+
+ *address_return = address;
+
+ return 1;
+}
/* Table of operators and their precedences for printing expressions. */
@@ -502,7 +534,7 @@ const struct language_defn f_language_de
f_language_arch_info,
default_print_array_index,
default_pass_by_reference,
- default_value_address_get, /* Retrieve the real data value */
+ f_value_address_get, /* Retrieve the real data value */
LANG_MAGIC
};
Index: sources/gdb/Makefile.in
===================================================================
--- sources.orig/gdb/Makefile.in 2007-11-16 00:37:17.000000000 +0100
+++ sources/gdb/Makefile.in 2007-11-16 00:38:50.000000000 +0100
@@ -2005,7 +2005,7 @@ dwarf2read.o: dwarf2read.c $(defs_h) $(b
$(expression_h) $(filenames_h) $(macrotab_h) $(language_h) \
$(complaints_h) $(bcache_h) $(dwarf2expr_h) $(dwarf2loc_h) \
$(cp_support_h) $(hashtab_h) $(command_h) $(gdbcmd_h) \
- $(gdb_string_h) $(gdb_assert_h) $(gdbcore_h) $(exceptions_h)
+ $(gdb_string_h) $(gdb_assert_h) $(gdbcore_h) $(exceptions_h) $(f_lang_h)
elfread.o: elfread.c $(defs_h) $(bfd_h) $(gdb_string_h) $(elf_bfd_h) \
$(elf_mips_h) $(symtab_h) $(symfile_h) $(objfiles_h) $(buildsym_h) \
$(stabsread_h) $(gdb_stabs_h) $(complaints_h) $(demangle_h) \
@@ -2044,7 +2044,7 @@ findvar.o: findvar.c $(defs_h) $(symtab_
$(user_regs_h) $(block_h)
f-lang.o: f-lang.c $(defs_h) $(gdb_string_h) $(symtab_h) $(gdbtypes_h) \
$(expression_h) $(parser_defs_h) $(language_h) $(f_lang_h) \
- $(valprint_h) $(value_h)
+ $(valprint_h) $(value_h) $(dwarf2expr_h)
fork-child.o: fork-child.c $(defs_h) $(gdb_string_h) $(frame_h) \
$(inferior_h) $(target_h) $(gdb_wait_h) $(gdb_vfork_h) $(gdbcore_h) \
$(terminal_h) $(gdbthread_h) $(command_h) $(solib_h)
@@ -2069,7 +2069,7 @@ frv-tdep.o: frv-tdep.c $(defs_h) $(gdb_s
$(frv_tdep_h)
f-typeprint.o: f-typeprint.c $(defs_h) $(gdb_obstack_h) $(bfd_h) $(symtab_h) \
$(gdbtypes_h) $(expression_h) $(value_h) $(gdbcore_h) $(target_h) \
- $(f_lang_h) $(gdb_string_h)
+ $(f_lang_h) $(gdb_string_h) $(dwarf2expr_h)
f-valprint.o: f-valprint.c $(defs_h) $(gdb_string_h) $(symtab_h) \
$(gdbtypes_h) $(expression_h) $(value_h) $(valprint_h) $(language_h) \
$(f_lang_h) $(frame_h) $(gdbcore_h) $(command_h) $(block_h)