From patchwork Wed Jul 1 12:42:11 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Keven Boell X-Patchwork-Id: 7442 Received: (qmail 94514 invoked by alias); 1 Jul 2015 12:42:03 -0000 Mailing-List: contact gdb-patches-help@sourceware.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Subscribe: List-Archive: List-Post: List-Help: , Sender: gdb-patches-owner@sourceware.org Delivered-To: mailing list gdb-patches@sourceware.org Received: (qmail 94436 invoked by uid 89); 1 Jul 2015 12:42:02 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-0.0 required=5.0 tests=AWL, BAYES_40, KAM_LAZY_DOMAIN_SECURITY, KAM_STOCKGEN, RP_MATCHES_RCVD autolearn=no version=3.3.2 X-HELO: mga03.intel.com Received: from mga03.intel.com (HELO mga03.intel.com) (134.134.136.65) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 01 Jul 2015 12:42:01 +0000 Received: from orsmga003.jf.intel.com ([10.7.209.27]) by orsmga103.jf.intel.com with ESMTP; 01 Jul 2015 05:41:59 -0700 X-ExtLoop1: 1 Received: from irvmail001.ir.intel.com ([163.33.26.43]) by orsmga003.jf.intel.com with ESMTP; 01 Jul 2015 05:41:58 -0700 Received: from ullecvh004g04.iul.intel.com (ullecvh004g04.iul.intel.com [172.28.50.14]) by irvmail001.ir.intel.com (8.14.3/8.13.6/MailSET/Hub) with ESMTP id t61Cfv40003873; Wed, 1 Jul 2015 13:41:57 +0100 Received: from ullecvh004g04.iul.intel.com (ullecvh004g04.iul.intel.com [127.0.0.1]) by ullecvh004g04.iul.intel.com (8.13.8/8.13.8) with ESMTP id t61CgECD017958; Wed, 1 Jul 2015 14:42:14 +0200 Received: (from kboell@localhost) by ullecvh004g04.iul.intel.com (8.13.8/8.13.8/Submit) id t61CgEsx017957; Wed, 1 Jul 2015 14:42:14 +0200 From: Keven Boell To: gdb-patches@sourceware.org Cc: Keven Boell Subject: [PATCH 1/2] fort_dyn_array: add basic fortran dyn array support Date: Wed, 1 Jul 2015 14:42:11 +0200 Message-Id: <1435754532-17922-2-git-send-email-keven.boell@intel.com> In-Reply-To: <1435754532-17922-1-git-send-email-keven.boell@intel.com> References: <1435754532-17922-1-git-send-email-keven.boell@intel.com> Fortran provide types whose values may be dynamically allocated or associated with a variable under explicit program control. The purpose of this commit is * to read allocated/associated DWARF tags and store them in the dynamic property list of main_type. * enable GDB to print the value of a dynamic array in Fortran in case the type is allocated or associated (pointer to dynamic array). Examples: (gdb) p vla_not_allocated $1 = (gdb) p vla_allocated $1 = (1, 2, 3) (gdb) p vla_ptr_not_associated $1 = (gdb) p vla_ptr_associated $1 = (1, 2, 3) 2015-03-13 Keven Boell * dwarf2loc.c (dwarf2_address_data_valid): New function. * dwarf2loc.h (dwarf2_address_data_valid): New function. * dwarf2read.c (set_die_type): Add read of DW_AT_allocated and DW_AT_associated. * f-typeprint.c (f_print_type): Add check for allocated/associated status of type. (f_type_print_varspec_suffix): Add check for allocated/associated status of type. * gdbtypes.c (create_array_type_with_stride): Add check for valid data location of type in case allocated or associated attributes are set. Length of an array should be only calculated if allocated or associated is resolved as true. (is_dynamic_type_internal): Add check for allocated/ associated. (resolve_dynamic_array): Evaluate allocated/associated properties. Since at the end of the function a new array type will be created where the length is calculated the properties need to be resolved before. * gdbtypes.h (enum dynamic_prop_node_kind): Add allocated/associated. Add convenient macros to handle allocated/associated. * valarith.c (value_subscripted_rvalue): Add check for allocated/associated. * valprint.c (valprint_check_validity): Add check for allocated/associated. (val_print_not_allocated): New function. (val_print_not_associated): New function. (value_check_printable): Add check for allocated/ associated. * valprint.h (val_print_not_allocated): New function. (val_print_not_associated): New function. --- gdb/dwarf2loc.c | 11 +++++++++++ gdb/dwarf2loc.h | 4 ++++ gdb/dwarf2read.c | 16 ++++++++++++++++ gdb/f-typeprint.c | 20 ++++++++++++++++++++ gdb/gdbtypes.c | 33 ++++++++++++++++++++++++++++----- gdb/gdbtypes.h | 28 ++++++++++++++++++++++++++++ gdb/valarith.c | 9 ++++++++- gdb/valprint.c | 36 ++++++++++++++++++++++++++++++++++++ gdb/valprint.h | 4 ++++ 9 files changed, 155 insertions(+), 6 deletions(-) diff --git a/gdb/dwarf2loc.c b/gdb/dwarf2loc.c index c75767e..c4a43ca 100644 --- a/gdb/dwarf2loc.c +++ b/gdb/dwarf2loc.c @@ -2576,6 +2576,17 @@ dwarf2_compile_property_to_c (struct ui_file *stream, data, data + size, per_cu); } +int +dwarf2_address_data_valid (const struct type *type) +{ + if (TYPE_NOT_ASSOCIATED (type)) + return 0; + + if (TYPE_NOT_ALLOCATED (type)) + return 0; + + return 1; +} /* Helper functions and baton for dwarf2_loc_desc_needs_frame. */ diff --git a/gdb/dwarf2loc.h b/gdb/dwarf2loc.h index f3630ac..c664c4d 100644 --- a/gdb/dwarf2loc.h +++ b/gdb/dwarf2loc.h @@ -155,6 +155,10 @@ void dwarf2_compile_property_to_c (struct ui_file *stream, CORE_ADDR dwarf2_read_addr_index (struct dwarf2_per_cu_data *per_cu, unsigned int addr_index); +/* Checks if a dwarf location definition is valid. + Returns 1 if valid; 0 otherwise. */ +extern int dwarf2_address_data_valid (const struct type *type); + /* The symbol location baton types used by the DWARF-2 reader (i.e. SYMBOL_LOCATION_BATON for a LOC_COMPUTED symbol). "struct dwarf2_locexpr_baton" is for a symbol with a single location diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c index 496b74f..69caa04 100644 --- a/gdb/dwarf2read.c +++ b/gdb/dwarf2read.c @@ -22263,6 +22263,22 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu) && !HAVE_GNAT_AUX_INFO (type)) INIT_GNAT_SPECIFIC (type); + /* Read DW_AT_allocated and set in type. */ + attr = dwarf2_attr (die, DW_AT_allocated, cu); + if (attr_form_is_block (attr)) + { + if (attr_to_dynamic_prop (attr, die, cu, &prop)) + add_dyn_prop (DYN_PROP_ALLOCATED, prop, type, objfile); + } + + /* Read DW_AT_associated and set in type. */ + attr = dwarf2_attr (die, DW_AT_associated, cu); + if (attr_form_is_block (attr)) + { + if (attr_to_dynamic_prop (attr, die, cu, &prop)) + add_dyn_prop (DYN_PROP_ASSOCIATED, prop, type, objfile); + } + /* Read DW_AT_data_location and set in type. */ attr = dwarf2_attr (die, DW_AT_data_location, cu); if (attr_to_dynamic_prop (attr, die, cu, &prop)) diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c index 4957e1f..50efbdb 100644 --- a/gdb/f-typeprint.c +++ b/gdb/f-typeprint.c @@ -30,6 +30,7 @@ #include "gdbcore.h" #include "target.h" #include "f-lang.h" +#include "valprint.h" #if 0 /* Currently unused. */ static void f_type_print_args (struct type *, struct ui_file *); @@ -53,6 +54,18 @@ f_print_type (struct type *type, const char *varstring, struct ui_file *stream, enum type_code code; int demangled_args; + if (TYPE_NOT_ASSOCIATED (type)) + { + val_print_not_associated (stream); + return; + } + + if (TYPE_NOT_ALLOCATED (type)) + { + val_print_not_allocated (stream); + return; + } + f_type_print_base (type, stream, show, level); code = TYPE_CODE (type); if ((varstring != NULL && *varstring != '\0') @@ -167,6 +180,12 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream, if (arrayprint_recurse_level == 1) fprintf_filtered (stream, "("); + if (TYPE_NOT_ASSOCIATED (type)) + val_print_not_associated (stream); + else if (TYPE_NOT_ALLOCATED (type)) + val_print_not_allocated (stream); + else + { if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY) f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0, arrayprint_recurse_level); @@ -189,6 +208,7 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream, if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY) f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0, arrayprint_recurse_level); + } if (arrayprint_recurse_level == 1) fprintf_filtered (stream, ")"); else diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c index ca86fbd..05cd795 100644 --- a/gdb/gdbtypes.c +++ b/gdb/gdbtypes.c @@ -1068,7 +1068,8 @@ create_array_type_with_stride (struct type *result_type, TYPE_CODE (result_type) = TYPE_CODE_ARRAY; TYPE_TARGET_TYPE (result_type) = element_type; - if (has_static_range (TYPE_RANGE_DATA (range_type))) + if (has_static_range (TYPE_RANGE_DATA (range_type)) + && dwarf2_address_data_valid (result_type)) { LONGEST low_bound, high_bound; @@ -1806,6 +1807,12 @@ is_dynamic_type_internal (struct type *type, int top_level) || TYPE_DATA_LOCATION_KIND (type) == PROP_LOCLIST)) return 1; + if (TYPE_ASSOCIATED_PROP (type)) + return 1; + + if (TYPE_ALLOCATED_PROP (type)) + return 1; + switch (TYPE_CODE (type)) { case TYPE_CODE_RANGE: @@ -1923,6 +1930,8 @@ resolve_dynamic_array (struct type *type, struct type *elt_type; struct type *range_type; struct type *ary_dim; + struct type *copy = copy_type (type); + struct dynamic_prop *prop; gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY); @@ -1930,16 +1939,30 @@ resolve_dynamic_array (struct type *type, range_type = check_typedef (TYPE_INDEX_TYPE (elt_type)); range_type = resolve_dynamic_range (range_type, addr_stack); + /* Resolve allocated/associated here before creating a new array type, which + will update the length of the array accordingly. */ + prop = TYPE_ALLOCATED_PROP (copy); + if (prop != NULL && dwarf2_evaluate_property (prop, addr_stack, &value)) + { + TYPE_DYN_PROP_ADDR (prop) = value; + TYPE_DYN_PROP_KIND (prop) = PROP_CONST; + } + prop = TYPE_ASSOCIATED_PROP (copy); + if (prop != NULL && dwarf2_evaluate_property (prop, addr_stack, &value)) + { + TYPE_DYN_PROP_ADDR (prop) = value; + TYPE_DYN_PROP_KIND (prop) = PROP_CONST; + } + ary_dim = check_typedef (TYPE_TARGET_TYPE (elt_type)); if (ary_dim != NULL && TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY) - elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (type), addr_stack); + elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (copy), addr_stack); else elt_type = TYPE_TARGET_TYPE (type); - return create_array_type_with_stride (copy_type (type), - elt_type, range_type, - TYPE_FIELD_BITSIZE (type, 0)); + return create_array_type_with_stride (copy, + elt_type, range_type, TYPE_FIELD_BITSIZE (type, 0)); } /* Resolve dynamic bounds of members of the union TYPE to static diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h index fd3bc0e..ebed54c 100644 --- a/gdb/gdbtypes.h +++ b/gdb/gdbtypes.h @@ -440,6 +440,16 @@ enum dynamic_prop_node_kind /* A property providing a type's data location. Evaluating this field yields to the location of an object's data. */ DYN_PROP_DATA_LOCATION, + + /* A property representing DW_AT_allocated. The presence of this attribute + indicates that the object of the type can be allocated/deallocated. + The value can be a dwarf expression, reference, or a constant. */ + DYN_PROP_ALLOCATED, + + /* A property representing DW_AT_allocated. The presence of this attribute + indicated that the object of the type can be associated. The value can be + a dwarf expression, reference, or a constant.*/ + DYN_PROP_ASSOCIATED, }; /* * List for dynamic type attributes. */ @@ -1266,6 +1276,24 @@ extern void allocate_gnat_aux_type (struct type *); #define TYPE_DATA_LOCATION_KIND(thistype) \ TYPE_DATA_LOCATION (thistype)->kind +/* Property accessors for the type allocated/associated. */ +#define TYPE_ALLOCATED_PROP(thistype) \ + get_dyn_prop (DYN_PROP_ALLOCATED, thistype) +#define TYPE_ASSOCIATED_PROP(thistype) \ + get_dyn_prop (DYN_PROP_ASSOCIATED, thistype) + +/* Allocated status of type object. If set to non-zero it means the object + is allocated. A zero value means it is not allocated. */ +#define TYPE_NOT_ALLOCATED(t) (TYPE_ALLOCATED_PROP (t) \ + && TYPE_DYN_PROP_KIND (TYPE_ALLOCATED_PROP (t)) == PROP_CONST \ + && !TYPE_DYN_PROP_ADDR (TYPE_ALLOCATED_PROP (t))) + +/* Associated status of type object. If set to non-zero it means the object + is associated. A zero value means it is not associated. */ +#define TYPE_NOT_ASSOCIATED(t) (TYPE_ASSOCIATED_PROP (t) \ + && TYPE_DYN_PROP_KIND (TYPE_ASSOCIATED_PROP (t)) == PROP_CONST \ + && !TYPE_DYN_PROP_ADDR (TYPE_ASSOCIATED_PROP (t))) + /* Attribute accessors for dynamic properties. */ #define TYPE_DYN_PROP_LIST(thistype) \ TYPE_MAIN_TYPE(thistype)->dyn_prop_list diff --git a/gdb/valarith.c b/gdb/valarith.c index df1e8c3..9c959b3 100644 --- a/gdb/valarith.c +++ b/gdb/valarith.c @@ -198,7 +198,14 @@ value_subscripted_rvalue (struct value *array, LONGEST index, int lowerbound) if (index < lowerbound || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type) && elt_offs >= TYPE_LENGTH (array_type))) - error (_("no such vector element")); + { + if (TYPE_NOT_ASSOCIATED (array_type)) + error (_("no such vector element because not associated")); + else if (TYPE_NOT_ALLOCATED (array_type)) + error (_("no such vector element because not allocated")); + else + error (_("no such vector element")); + } if (VALUE_LVAL (array) == lval_memory && value_lazy (array)) v = allocate_value_lazy (elt_type); diff --git a/gdb/valprint.c b/gdb/valprint.c index 294c6a8..55bd59f 100644 --- a/gdb/valprint.c +++ b/gdb/valprint.c @@ -303,6 +303,18 @@ valprint_check_validity (struct ui_file *stream, { CHECK_TYPEDEF (type); + if (TYPE_NOT_ASSOCIATED (type)) + { + val_print_not_associated (stream); + return 0; + } + + if (TYPE_NOT_ALLOCATED (type)) + { + val_print_not_allocated (stream); + return 0; + } + if (TYPE_CODE (type) != TYPE_CODE_UNION && TYPE_CODE (type) != TYPE_CODE_STRUCT && TYPE_CODE (type) != TYPE_CODE_ARRAY) @@ -359,6 +371,18 @@ val_print_invalid_address (struct ui_file *stream) fprintf_filtered (stream, _("")); } +void +val_print_not_allocated (struct ui_file *stream) +{ + fprintf_filtered (stream, _("")); +} + +void +val_print_not_associated (struct ui_file *stream) +{ + fprintf_filtered (stream, _("")); +} + /* A generic val_print that is suitable for use by language implementations of the la_val_print method. This function can handle most type codes, though not all, notably exception @@ -833,6 +857,18 @@ value_check_printable (struct value *val, struct ui_file *stream, return 0; } + if (TYPE_NOT_ASSOCIATED (value_type (val))) + { + val_print_not_associated (stream); + return 0; + } + + if (TYPE_NOT_ALLOCATED (value_type (val))) + { + val_print_not_allocated (stream); + return 0; + } + return 1; } diff --git a/gdb/valprint.h b/gdb/valprint.h index ed4964f..1210b83 100644 --- a/gdb/valprint.h +++ b/gdb/valprint.h @@ -232,4 +232,8 @@ extern void print_command_parse_format (const char **expp, const char *cmdname, struct format_data *fmtp); extern void print_value (struct value *val, const struct format_data *fmtp); +extern void val_print_not_allocated (struct ui_file *stream); + +extern void val_print_not_associated (struct ui_file *stream); + #endif