From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 38142 invoked by alias); 20 Oct 2015 20:13:42 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Received: (qmail 38130 invoked by uid 89); 20 Oct 2015 20:13:41 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=1.4 required=5.0 tests=AWL,BAYES_95,KAM_LAZY_DOMAIN_SECURITY,KAM_LOTSOFHASH,RCVD_IN_DNSWL_LOW autolearn=no version=3.3.2 X-HELO: smtp.eu.adacore.com Received: from mel.act-europe.fr (HELO smtp.eu.adacore.com) (194.98.77.210) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-GCM-SHA384 encrypted) ESMTPS; Tue, 20 Oct 2015 20:13:23 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id B75E427BE86D; Tue, 20 Oct 2015 22:13:19 +0200 (CEST) Received: from smtp.eu.adacore.com ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id fOegpwzDLA0M; Tue, 20 Oct 2015 22:13:19 +0200 (CEST) Received: from [192.168.40.126] (nat.gnat.com [205.232.38.191]) (using TLSv1.2 with cipher ECDHE-RSA-AES128-GCM-SHA256 (128/128 bits)) (No client certificate requested) by smtp.eu.adacore.com (Postfix) with ESMTPSA id 6C99127BE752; Tue, 20 Oct 2015 22:13:18 +0200 (CEST) Subject: [PATCHES, PING*5] Enhance standard DWARF for Ada To: gcc-patches@gcc.gnu.org References: <55A76C7B.7080303@adacore.com> <55B0C74D.3040907@adacore.com> <55BB53F3.1080101@adacore.com> <55BB56B1.8080407@adacore.com> <55C5C54E.8050700@adacore.com> <55E4025B.3050309@adacore.com> Cc: Jason Merill , Cary Coutant , Eric Botcazou From: Pierre-Marie de Rodat Message-ID: <5626A05D.3090905@adacore.com> Date: Tue, 20 Oct 2015 20:20:00 -0000 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:38.0) Gecko/20100101 Thunderbird/38.3.0 MIME-Version: 1.0 In-Reply-To: <55E4025B.3050309@adacore.com> Content-Type: multipart/mixed; boundary="------------080408090101090205000303" X-IsSubscribed: yes X-SW-Source: 2015-10/txt/msg01953.txt.bz2 This is a multi-part message in MIME format. --------------080408090101090205000303 Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 8bit Content-length: 468 On 07/16/2015 10:34 AM, Pierre-Marie de Rodat wrote: > This patch series aims at enhancing GCC to emit standard DWARF in > place of the current GNAT encodings (non-standard DWARF) for a set of > "basic" types: dynamic arrays, variable-length records, variant > parts, etc. Ping for the patch series: https://gcc.gnu.org/ml/gcc-patches/2015-07/msg01353.html. Also, here’s the updated patchset (rebased against trunk). Thanks in advance! -- Pierre-Marie de Rodat --------------080408090101090205000303 Content-Type: text/x-diff; name="0001-Add-a-flag-to-control-the-balance-between-GNAT-encod.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename*0="0001-Add-a-flag-to-control-the-balance-between-GNAT-encod.pa"; filename*1="tch" Content-length: 4778 >From 97acb58ce7cc079ff593e45e31d2fc6f44948001 Mon Sep 17 00:00:00 2001 From: Pierre-Marie de Rodat Date: Wed, 17 Sep 2014 14:54:50 +0200 Subject: [PATCH 1/8] Add a flag to control the balance between GNAT encodings and std. DWARF In order to accomodate the debugger's support evolution for "new" DWARF constructs, we need to have an flag that controls the amount of GNAT encodings/standard DWARF information that is emitted in the debug info. Propagate this new parameter into the Ada front-end. gcc/ChangeLog: * common.opt (gnat_encodings): New variable (dwarf_gnat_encodings): New enum type. (fgnat_encodings): New option. * flag-types.h (enum dwarf_gnat_encodings): New. gcc/ada/ChangeLog: * gcc-interface/misc.c (gnat_encodings): Undefine macro and declare a global variable. (gnat_post_options): Initialize this global from options. --- gcc/ada/gcc-interface/misc.c | 4 +++- gcc/common.opt | 21 +++++++++++++++++++++ gcc/defaults.h | 4 ++++ gcc/flag-types.h | 15 +++++++++++++++ 4 files changed, 43 insertions(+), 1 deletion(-) diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c index 1282342..a9be2b5 100644 --- a/gcc/ada/gcc-interface/misc.c +++ b/gcc/ada/gcc-interface/misc.c @@ -241,12 +241,13 @@ gnat_init_options (unsigned int decoded_options_count, /* Ada code requires variables for these settings rather than elements of the global_options structure. */ +#undef gnat_encodings #undef optimize #undef optimize_size #undef flag_compare_debug #undef flag_short_enums #undef flag_stack_check -int gnat_encodings = 0; +enum dwarf_gnat_encodings gnat_encodings = DWARF_GNAT_ENCODINGS_DEFAULT; int optimize; int optimize_size; int flag_compare_debug; @@ -280,6 +281,7 @@ gnat_post_options (const char **pfilename ATTRIBUTE_UNUSED) "supported anymore"); /* Copy global settings to local versions. */ + gnat_encodings = global_options.x_gnat_encodings; optimize = global_options.x_optimize; optimize_size = global_options.x_optimize_size; flag_compare_debug = global_options.x_flag_compare_debug; diff --git a/gcc/common.opt b/gcc/common.opt index 224d3ad..ce78846 100644 --- a/gcc/common.opt +++ b/gcc/common.opt @@ -166,6 +166,11 @@ bool flag_stack_usage_info = false Variable int flag_debug_asm + +; Balance between GNAT encodings and standard DWARF to emit. +Variable +enum dwarf_gnat_encodings gnat_encodings = DWARF_GNAT_ENCODINGS_DEFAULT + ; -dP causes the rtl to be emitted as a comment in assembly. Variable int flag_dump_rtl_in_asm @@ -1327,6 +1332,22 @@ Common Report Var(flag_gcse_after_reload) Optimization Perform global common subexpression elimination after register allocation has finished +Enum +Name(dwarf_gnat_encodings) Type(int) + +EnumValue +Enum(dwarf_gnat_encodings) String(all) Value(DWARF_GNAT_ENCODINGS_ALL) + +EnumValue +Enum(dwarf_gnat_encodings) String(gdb) Value(DWARF_GNAT_ENCODINGS_GDB) + +EnumValue +Enum(dwarf_gnat_encodings) String(minimal) Value(DWARF_GNAT_ENCODINGS_MINIMAL) + +fgnat-encodings= +Common Enum(dwarf_gnat_encodings) Joined RejectNegative Report Undocumented Var(gnat_encodings) +-fgnat-encodings=[all|gdb|minimal] Select the balance between GNAT encodings and standard DWARF emitted in the debug information + ; This option is not documented yet as its semantics will change. fgraphite Common Report Var(flag_graphite) Optimization diff --git a/gcc/defaults.h b/gcc/defaults.h index cee799d..65930b2 100644 --- a/gcc/defaults.h +++ b/gcc/defaults.h @@ -1476,4 +1476,8 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #endif /* GCC_INSN_FLAGS_H */ +#ifndef DWARF_GNAT_ENCODINGS_DEFAULT +#define DWARF_GNAT_ENCODINGS_DEFAULT DWARF_GNAT_ENCODINGS_GDB +#endif + #endif /* ! GCC_DEFAULTS_H */ diff --git a/gcc/flag-types.h b/gcc/flag-types.h index 6301cea..232ed2c 100644 --- a/gcc/flag-types.h +++ b/gcc/flag-types.h @@ -91,6 +91,21 @@ enum debug_struct_file DINFO_STRUCT_FILE_ANY /* Debug structs defined in all files. */ }; +/* Balance between GNAT encodings and standard DWARF to emit. */ + +enum dwarf_gnat_encodings +{ + DWARF_GNAT_ENCODINGS_ALL = 0, /* Emit all GNAT encodings, then emit as + much standard DWARF as possible so it + does not conflict with GNAT + encodings. */ + DWARF_GNAT_ENCODINGS_GDB = 1, /* Emit as much standard DWARF as possible + as long as GDB handles them. Emit GNAT + encodings for the rest. */ + DWARF_GNAT_ENCODINGS_MINIMAL = 2 /* Emit all the standard DWARF we can. + Emit GNAT encodings for the rest. */ +}; + /* Enumerate Objective-c instance variable visibility settings. */ enum ivar_visibility -- 2.6.0 --------------080408090101090205000303 Content-Type: text/x-diff; name="0002-DWARF-handle-variable-length-records-and-variant-par.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename*0="0002-DWARF-handle-variable-length-records-and-variant-par.pa"; filename*1="tch" Content-length: 108305 >From fcf87271f1f46363eaeb8e23bd83c966fae1b5e4 Mon Sep 17 00:00:00 2001 From: Pierre-Marie de Rodat Date: Thu, 3 Jul 2014 14:16:09 +0200 Subject: [PATCH 2/8] DWARF: handle variable-length records and variant parts Enhance the DWARF back-end to emit proper descriptions for variable-length records as well as variant parts in records. In order to achieve this, generate DWARF expressions ("location descriptions" in dwarf2out's parlance) for size and data member location attributes. Also match QUAL_UNION_TYPE data types as variant parts, assuming the formers appear only to implement the latters (which is the case at the moment: only the Ada front-end emits them). Note that very few debuggers can handle these descriptions (GDB does not yet), so in order to ease the the transition enable these only when -fgnat-encodings=minimal. gcc/ada/ChangeLog: * gcc-interface/decl.c (gnat_to_gnu_entity): Disable ___XVS GNAT encodings when -fgnat-encodings=minimal. (components_to_record): Disable ___XVE, ___XVN, ___XVU and ___XVZ GNAT encodings when -fgnat-encodings=minimal. * gcc-interface/utils.c (maybe_pad_type): Disable __XVS GNAT encodings when -fgnat-encodings=minimal. gcc/ChangeLog: * function.h (struct function): Add a preserve_body field. * cgraph.c (cgraph_node::release_body): Preserve bodies when asked to by the preserve_body field. * stor-layout.c (finalize_size_functions): Keep a copy of the original function tree and set the preserve_body field in the function structure. * dwarf2out.h (dw_discr_list_ref): New typedef. (enum dw_val_class): Add value classes for discriminant values and discriminant lists. (struct dw_discr_value): New structure. (struct dw_val_node): Add discriminant values and discriminant lists to the union. (struct dw_loc_descr_node): Add frame_offset_rel, dw_loc_frame_offset and dw_loc_frame_offset_increment fields to handle DWARF procedures generation. (struct dw_discr_list_node): New structure. * dwarf2out.c (new_loc_descr): Initialize the dw_loc_frame_offset field. (dw_val_equal_p): Handle discriminants. (size_of_discr_value): New. (size_of_discr_list): New. (size_of_die): Handle discriminants. (add_loc_descr_to_each): New. (add_loc_list): New. (print_discr_value): New. (print_dw_val): Handle discriminants. (value_format): Handle discriminants. (output_discr_value): New. (output_die): Handle discriminants. (output_loc_operands): Handle DW_OP_call2 and DW_OP_call4. (uint_loc_descriptor): New. (uint_comparison_loc_list): New. (loc_list_from_uint_comparison): New. (add_discr_value): New. (add_discr_list): New. (AT_discr_list): New. (loc_descr_to_next_no_op): New. (free_loc_descr): New. (loc_descr_without_nops): New. (struct loc_descr_context): Add a dpi field. (struct dwarf_procedure_info): New helper structure. (new_dwarf_proc_die): New. (is_handled_procedure_type): New. (resolve_args_picking): New. (function_to_dwarf_procedure): New. (copy_dwarf_procedure): New. (copy_dwarf_procs_ref_in_attrs): New. (copy_dwarf_procs_ref_in_dies): New. (break_out_comdat_types): Copy DWARF procedures along with the types that reference them. (loc_list_from_tree): Rename into loc_list_from_tree_1. Handle CALL_EXPR in the cases suitable for DWARF procedures. Handle for PARM_DECL when generating a location description for a DWARF procedure. Handle big unsigned INTEGER_CST nodes. Handle NON_LVALUE_EXPR, EXACT_DIV_EXPR and all unsigned comparison operators. Add a wrapper for loc_list_from_tree that strips DW_OP_nop operations from the result. (type_byte_size): New. (struct vlr_context): New helper structure. (field_byte_offset): Change signature to return either a constant offset or a location description for dynamic ones. Handle dynamic byte offsets with constant bit offsets and handle fields in variant parts. (add_data_member_location): Change signature to handle dynamic member offsets and fields in variant parts. Update call to field_byte_offset. Handle location lists. Emit a variable data member location only when -fgnat-encodings=minimal. (add_bound_info): Emit self-referential bounds only when -fgnat-encodings=minimal. (add_byte_size_attribute): Use type_byte_size in order to handle dynamic type sizes. Emit variable byte size only when -fgnat-encodings=minimal and when the target DWARF version allows them. (add_bit_offset_attribute): Change signature to handle variable-length records. Update call to field_byte_offset. (gen_descr_array_type_die): Update call to gen_field_die. Update loc_descr_context literal. (gen_type_die_for_member): Likewise. (gen_subprogram_die): Update calls to get_decl_die. (gen_field_die): Change signature to handle variable-length records. Update calls to add_bit_offset_attribute and add_data_member_location_attribute. (gen_inheritance_die): Update call to add_data_member_location_attribute. (gen_decl_die): Change signature to handle variable-length records. Update call to gen_field_die. (gen_inheritance_die): Change signature to handle variable-length records. Update call to add_data_member_location_attribute. (is_variant_part): New. (analyze_discr_in_predicate): New. (get_discr_value): New. (analyze_variants_discr): New. (gen_variant_part): New. (gen_member_die): Update calls to gen_decl_die. Call instead gen_variant_part for variant parts. (gen_type_die_with_usage): Update calls to gen_decl_die. (process_scope_var): Likewise. (force_decl_die): Likewise. (declare_in_namespace): Likewise. (dwarf2out_decl): Likewise. (prune_unused_types_walk_loc_descr): New. (prune_unused_types_walk_attribs): Mark DIEs referenced by location descriptions and loc. descr. lists. (prune_unused_types_walk): Don't mark DWARF procedures by default. Mark variant parts since nothing is supposed to reference them. gcc/testsuite/ChangeLog: * gnat.dg/specs/debug1.ads: Update the expected number of DW_AT_artificial attribute in compiler output. --- gcc/ada/gcc-interface/decl.c | 19 +- gcc/ada/gcc-interface/utils.c | 8 +- gcc/cgraph.c | 12 +- gcc/dwarf2out.c | 1995 +++++++++++++++++++++++++++++--- gcc/dwarf2out.h | 52 +- gcc/function.h | 6 + gcc/stor-layout.c | 9 + gcc/testsuite/gnat.dg/specs/debug1.ads | 2 +- 8 files changed, 1935 insertions(+), 168 deletions(-) diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index ca36ce5..1bd1cd2 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -3566,10 +3566,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Fill in locations of fields. */ annotate_rep (gnat_entity, gnu_type); - /* If debugging information is being written for the type, write - a record that shows what we are a subtype of and also make a - variable that indicates our size, if still variable. */ - if (debug_info_p) + /* If debugging information is being written for the type and if + we are asked to output such encodings, write a record that + shows what we are a subtype of and also make a variable that + indicates our size, if still variable. */ + if (gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL) { tree gnu_subtype_marker = make_node (RECORD_TYPE); tree gnu_unpad_base_name @@ -6929,6 +6930,8 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, bool debug_info, bool maybe_unused, bool reorder, tree first_free_pos, tree *p_gnu_rep_list) { + const bool needs_xv_encodings + = debug_info && gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL; bool all_rep_and_size = all_rep && TYPE_SIZE (gnu_record_type); bool variants_have_rep = all_rep; bool layout_with_rep = false; @@ -7107,7 +7110,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, NULL_TREE, packed, definition, !all_rep_and_size, all_rep, unchecked_union, - true, debug_info, true, reorder, + true, needs_xv_encodings, true, reorder, this_first_free_pos, all_rep || this_first_free_pos ? NULL : &gnu_rep_list); @@ -7195,7 +7198,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, if (debug_info) rest_of_record_type_compilation (gnu_variant_type); create_type_decl (TYPE_NAME (gnu_variant_type), gnu_variant_type, - true, debug_info, gnat_component_list); + true, needs_xv_encodings, gnat_component_list); gnu_field = create_field_decl (gnu_variant->name, gnu_variant_type, @@ -7228,7 +7231,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, } finish_record_type (gnu_union_type, nreverse (gnu_variant_list), - all_rep_and_size ? 1 : 0, debug_info); + all_rep_and_size ? 1 : 0, needs_xv_encodings); /* If GNU_UNION_TYPE is our record type, it means we must have an Unchecked_Union with no fields. Verify that and, if so, just @@ -7242,7 +7245,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, } create_type_decl (TYPE_NAME (gnu_union_type), gnu_union_type, true, - debug_info, gnat_component_list); + needs_xv_encodings, gnat_component_list); /* Deal with packedness like in gnat_to_gnu_field. */ if (union_field_needs_strict_alignment) diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 917c280..94d5b16 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -1358,8 +1358,10 @@ maybe_pad_type (tree type, tree size, unsigned int align, /* Unless debugging information isn't being written for the input type, write a record that shows what we are a subtype of and also make a - variable that indicates our size, if still variable. */ - if (TREE_CODE (orig_size) != INTEGER_CST + variable that indicates our size, if still variable. Don't do this if + asked to output as few encodings as possible. */ + if (gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL + && TREE_CODE (orig_size) != INTEGER_CST && TYPE_NAME (record) && TYPE_NAME (type) && !(TREE_CODE (TYPE_NAME (type)) == TYPE_DECL @@ -1871,7 +1873,7 @@ rest_of_record_type_compilation (tree record_type) /* If this record type is of variable size, make a parallel record type that will tell the debugger how the former is laid out (see exp_dbug.ads). */ - if (var_size) + if (var_size && gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL) { tree new_record_type = make_node (TREE_CODE (record_type) == QUAL_UNION_TYPE diff --git a/gcc/cgraph.c b/gcc/cgraph.c index 1a64d789..3c8a390 100644 --- a/gcc/cgraph.c +++ b/gcc/cgraph.c @@ -1732,8 +1732,15 @@ release_function_body (tree decl) void cgraph_node::release_body (bool keep_arguments) { + bool preserve_body = false; + + if (DECL_STRUCT_FUNCTION (decl) != NULL) + preserve_body = DECL_STRUCT_FUNCTION (decl)->preserve_body; + ipa_transforms_to_apply.release (); - if (!used_as_abstract_origin && symtab->state != PARSING) + if (!used_as_abstract_origin + && symtab->state != PARSING + && !preserve_body) { DECL_RESULT (decl) = NULL; @@ -1745,7 +1752,8 @@ cgraph_node::release_body (bool keep_arguments) needed to emit debug info later. */ if (!used_as_abstract_origin && DECL_INITIAL (decl)) DECL_INITIAL (decl) = error_mark_node; - release_function_body (decl); + if (!preserve_body) + release_function_body (decl); if (lto_file_data) { lto_free_function_in_decl_state_for_node (this); diff --git a/gcc/dwarf2out.c b/gcc/dwarf2out.c index c1b7c7b..903e381 100644 --- a/gcc/dwarf2out.c +++ b/gcc/dwarf2out.c @@ -1308,6 +1308,7 @@ typedef struct GTY(()) dw_loc_list_struct { } dw_loc_list_node; static dw_loc_descr_ref int_loc_descriptor (HOST_WIDE_INT); +static dw_loc_descr_ref uint_loc_descriptor (unsigned HOST_WIDE_INT); /* Convert a DWARF stack opcode into its string name. */ @@ -1333,6 +1334,7 @@ new_loc_descr (enum dwarf_location_atom op, unsigned HOST_WIDE_INT oprnd1, dw_loc_descr_ref descr = ggc_cleared_alloc (); descr->dw_loc_opc = op; + descr->dw_loc_frame_offset = -1; descr->dw_loc_oprnd1.val_class = dw_val_class_unsigned_const; descr->dw_loc_oprnd1.val_entry = NULL; descr->dw_loc_oprnd1.v.val_unsigned = oprnd1; @@ -1435,6 +1437,13 @@ dw_val_equal_p (dw_val_node *a, dw_val_node *b) case dw_val_class_vms_delta: return (!strcmp (a->v.val_vms_delta.lbl1, b->v.val_vms_delta.lbl1) && !strcmp (a->v.val_vms_delta.lbl1, b->v.val_vms_delta.lbl1)); + + case dw_val_class_discr_value: + return (a->v.val_discr_value.pos == b->v.val_discr_value.pos + && a->v.val_discr_value.v.uval == b->v.val_discr_value.v.uval); + case dw_val_class_discr_list: + /* It makes no sense comparing two discriminant value lists. */ + return false; } gcc_unreachable (); } @@ -1749,6 +1758,39 @@ size_of_locs (dw_loc_descr_ref loc) return size; } +/* Return the size of the value in a DW_AT_discr_value attribute. */ + +static int +size_of_discr_value (dw_discr_value *discr_value) +{ + if (discr_value->pos) + return size_of_uleb128 (discr_value->v.uval); + else + return size_of_sleb128 (discr_value->v.sval); +} + +/* Return the size of the value in a DW_discr_list attribute. */ + +static int +size_of_discr_list (dw_discr_list_ref discr_list) +{ + int size = 0; + + for (dw_discr_list_ref list = discr_list; + list != NULL; + list = list->dw_discr_next) + { + /* One byte for the discriminant value descriptor, and then one or two + LEB128 numbers, depending on whether it's a single case label or a + range label. */ + size += 1; + size += size_of_discr_value (&list->dw_discr_lower_bound); + if (list->dw_discr_range != 0) + size += size_of_discr_value (&list->dw_discr_upper_bound); + } + return size; +} + static HOST_WIDE_INT extract_int (const unsigned char *, unsigned); static void get_ref_die_offset_label (char *, dw_die_ref); static unsigned long int get_ref_die_offset (dw_die_ref); @@ -2011,6 +2053,22 @@ output_loc_operands (dw_loc_descr_ref loc, int for_eh_or_skip) "(index into .debug_addr)"); break; + case DW_OP_call2: + case DW_OP_call4: + { + unsigned long die_offset + = get_ref_die_offset (val1->v.val_die_ref.die); + /* Make sure the offset has been computed and that we can encode it as + an operand. */ + gcc_assert (die_offset > 0 + && die_offset <= (loc->dw_loc_opc == DW_OP_call2) + ? 0xffff + : 0xffffffff); + dw2_asm_output_data ((loc->dw_loc_opc == DW_OP_call2) ? 2 : 4, + die_offset, NULL); + } + break; + case DW_OP_GNU_implicit_pointer: { char label[MAX_ARTIFICIAL_LABEL_BYTES @@ -3250,6 +3308,8 @@ static dw_loc_descr_ref concat_loc_descriptor (rtx, rtx, static dw_loc_descr_ref loc_descriptor (rtx, machine_mode mode, enum var_init_status); struct loc_descr_context; +static void add_loc_descr_to_each (dw_loc_list_ref list, dw_loc_descr_ref ref); +static void add_loc_list (dw_loc_list_ref *ret, dw_loc_list_ref list); static dw_loc_list_ref loc_list_from_tree (tree, int, const struct loc_descr_context *); static dw_loc_descr_ref loc_descriptor_from_tree (tree, int, @@ -3259,10 +3319,13 @@ static tree field_type (const_tree); static unsigned int simple_type_align_in_bits (const_tree); static unsigned int simple_decl_align_in_bits (const_tree); static unsigned HOST_WIDE_INT simple_type_size_in_bits (const_tree); -static HOST_WIDE_INT field_byte_offset (const_tree); +struct vlr_context; +static dw_loc_descr_ref field_byte_offset (const_tree, struct vlr_context *, + HOST_WIDE_INT *); static void add_AT_location_description (dw_die_ref, enum dwarf_attribute, dw_loc_list_ref); -static void add_data_member_location_attribute (dw_die_ref, tree); +static void add_data_member_location_attribute (dw_die_ref, tree, + struct vlr_context *); static bool add_const_value_attribute (dw_die_ref, rtx); static void insert_int (HOST_WIDE_INT, unsigned, unsigned char *); static void insert_wide_int (const wide_int &, unsigned char *, int); @@ -3280,13 +3343,17 @@ static void add_bound_info (dw_die_ref, enum dwarf_attribute, tree, const struct loc_descr_context *); static void add_subscript_info (dw_die_ref, tree, bool); static void add_byte_size_attribute (dw_die_ref, tree); -static void add_bit_offset_attribute (dw_die_ref, tree); +static inline void add_bit_offset_attribute (dw_die_ref, tree, + struct vlr_context *); static void add_bit_size_attribute (dw_die_ref, tree); static void add_prototyped_attribute (dw_die_ref, tree); static dw_die_ref add_abstract_origin_attribute (dw_die_ref, tree); static void add_pure_or_virtual_attribute (dw_die_ref, tree); static void add_src_coords_attributes (dw_die_ref, tree); static void add_name_and_src_coords_attributes (dw_die_ref, tree); +static void add_discr_value (dw_die_ref, dw_discr_value *); +static void add_discr_list (dw_die_ref, dw_discr_list_ref); +static inline dw_discr_list_ref AT_discr_list (dw_attr_node *); static void push_decl_scope (tree); static void pop_decl_scope (void); static dw_die_ref scope_die_for (tree, dw_die_ref); @@ -3316,10 +3383,10 @@ static void gen_const_die (tree, dw_die_ref); static void gen_label_die (tree, dw_die_ref); static void gen_lexical_block_die (tree, dw_die_ref); static void gen_inlined_subroutine_die (tree, dw_die_ref); -static void gen_field_die (tree, dw_die_ref); +static void gen_field_die (tree, struct vlr_context *, dw_die_ref); static void gen_ptr_to_mbr_type_die (tree, dw_die_ref); static dw_die_ref gen_compile_unit_die (const char *); -static void gen_inheritance_die (tree, tree, dw_die_ref); +static void gen_inheritance_die (tree, tree, tree, dw_die_ref); static void gen_member_die (tree, dw_die_ref); static void gen_struct_or_union_type_die (tree, dw_die_ref, enum debug_info_usage); @@ -3333,7 +3400,7 @@ static bool is_naming_typedef_decl (const_tree); static inline dw_die_ref get_context_die (tree); static void gen_namespace_die (tree, dw_die_ref); static dw_die_ref gen_namelist_decl (tree, dw_die_ref, tree); -static dw_die_ref gen_decl_die (tree, tree, dw_die_ref); +static dw_die_ref gen_decl_die (tree, tree, struct vlr_context *, dw_die_ref); static dw_die_ref force_decl_die (tree); static dw_die_ref force_type_die (tree); static dw_die_ref setup_namespace_context (tree, dw_die_ref); @@ -5468,6 +5535,15 @@ print_signature (FILE *outfile, char *sig) fprintf (outfile, "%02x", sig[i] & 0xff); } +static inline void +print_discr_value (FILE *outfile, dw_discr_value *discr_value) +{ + if (discr_value->pos) + fprintf (outfile, HOST_WIDE_INT_PRINT_UNSIGNED, discr_value->v.sval); + else + fprintf (outfile, HOST_WIDE_INT_PRINT_DEC, discr_value->v.uval); +} + static void print_loc_descr (dw_loc_descr_ref, FILE *); /* Print the value associated to the VAL DWARF value node to OUTFILE. If @@ -5586,6 +5662,26 @@ print_dw_val (dw_val_node *val, bool recurse, FILE *outfile) fprintf (outfile, "%02x", val->v.val_data8[i]); break; } + case dw_val_class_discr_value: + print_discr_value (outfile, &val->v.val_discr_value); + break; + case dw_val_class_discr_list: + for (dw_discr_list_ref node = val->v.val_discr_list; + node != NULL; + node = node->dw_discr_next) + { + if (node->dw_discr_range) + { + fprintf (outfile, " .. "); + print_discr_value (outfile, &node->dw_discr_lower_bound); + print_discr_value (outfile, &node->dw_discr_upper_bound); + } + else + print_discr_value (outfile, &node->dw_discr_lower_bound); + + if (node->dw_discr_next != NULL) + fprintf (outfile, " | "); + } default: break; } @@ -7610,6 +7706,104 @@ remove_child_or_replace_with_skeleton (dw_die_ref unit, dw_die_ref child, return skeleton; } +static void +copy_dwarf_procs_ref_in_attrs (dw_die_ref die, + comdat_type_node *type_node, + hash_map &copied_dwarf_procs); + +/* Helper for copy_dwarf_procs_ref_in_dies. Make a copy of the DIE DWARF + procedure, put it under TYPE_NODE and return the copy. Continue looking for + DWARF procedure references in the DW_AT_location attribute. */ + +static dw_die_ref +copy_dwarf_procedure (dw_die_ref die, + comdat_type_node *type_node, + hash_map &copied_dwarf_procs) +{ + /* We do this for COMDAT section, which is DWARFv4 specific, so + DWARF procedure are always DW_TAG_dwarf_procedure DIEs (unlike + DW_TAG_variable in DWARFv3). */ + gcc_assert (die->die_tag == DW_TAG_dwarf_procedure); + + /* DWARF procedures are not supposed to have children... */ + gcc_assert (die->die_child == NULL); + + /* ... and they are supposed to have only one attribute: DW_AT_location. */ + gcc_assert (vec_safe_length (die->die_attr) == 1 + && ((*die->die_attr)[0].dw_attr == DW_AT_location)); + + /* Do not copy more than once DWARF procedures. */ + bool existed; + dw_die_ref &die_copy = copied_dwarf_procs.get_or_insert (die, &existed); + if (existed) + return die_copy; + + die_copy = clone_die (die); + add_child_die (type_node->root_die, die_copy); + copy_dwarf_procs_ref_in_attrs (die_copy, type_node, copied_dwarf_procs); + return die_copy; +} + +/* Helper for copy_dwarf_procs_ref_in_dies. Look for references to DWARF + procedures in DIE's attributes. */ + +static void +copy_dwarf_procs_ref_in_attrs (dw_die_ref die, + comdat_type_node *type_node, + hash_map &copied_dwarf_procs) +{ + dw_attr_node *a; + unsigned i; + + FOR_EACH_VEC_SAFE_ELT (die->die_attr, i, a) + { + dw_loc_descr_ref loc; + + if (a->dw_attr_val.val_class != dw_val_class_loc) + continue; + + for (loc = a->dw_attr_val.v.val_loc; loc != NULL; loc = loc->dw_loc_next) + { + switch (loc->dw_loc_opc) + { + case DW_OP_call2: + case DW_OP_call4: + case DW_OP_call_ref: + gcc_assert (loc->dw_loc_oprnd1.val_class + == dw_val_class_die_ref); + loc->dw_loc_oprnd1.v.val_die_ref.die + = copy_dwarf_procedure (loc->dw_loc_oprnd1.v.val_die_ref.die, + type_node, + copied_dwarf_procs); + + default: + break; + } + } + } +} + +/* Copy DWARF procedures that are referenced by the DIE tree to TREE_NODE and + rewrite references to point to the copies. + + References are looked for in DIE's attributes and recursively in all its + children attributes that are location descriptions. COPIED_DWARF_PROCS is a + mapping from old DWARF procedures to their copy. It is used not to copy + twice the same DWARF procedure under TYPE_NODE. */ + +static void +copy_dwarf_procs_ref_in_dies (dw_die_ref die, + comdat_type_node *type_node, + hash_map &copied_dwarf_procs) +{ + dw_die_ref c; + + copy_dwarf_procs_ref_in_attrs (die, type_node, copied_dwarf_procs); + FOR_EACH_CHILD (die, c, copy_dwarf_procs_ref_in_dies (c, + type_node, + copied_dwarf_procs)); +} + /* Traverse the DIE and set up additional .debug_types sections for each type worthy of being placed in a COMDAT section. */ @@ -7660,6 +7854,13 @@ break_out_comdat_types (dw_die_ref die) /* Add the DIE to the new compunit. */ add_child_die (unit, c); + /* Types can reference DWARF procedures for type size or data location + expressions. Calls in DWARF expressions cannot target procedures + that are not in the same section. So we must copy DWARF procedures + along with this type and then rewrite references to them. */ + hash_map copied_dwarf_procs; + copy_dwarf_procs_ref_in_dies (c, type_node, copied_dwarf_procs); + if (replacement != NULL) c = replacement; } @@ -8262,6 +8463,18 @@ size_of_die (dw_die_ref die) case dw_val_class_high_pc: size += DWARF2_ADDR_SIZE; break; + case dw_val_class_discr_value: + size += size_of_discr_value (&a->dw_attr_val.v.val_discr_value); + break; + case dw_val_class_discr_list: + { + unsigned block_size = size_of_discr_list (AT_discr_list (a)); + + /* This is a block, so we have the block length and then its + data. */ + size += constant_size (block_size) + block_size; + } + break; default: gcc_unreachable (); } @@ -8645,6 +8858,23 @@ value_format (dw_attr_node *a) gcc_unreachable (); } + case dw_val_class_discr_value: + return (a->dw_attr_val.v.val_discr_value.pos + ? DW_FORM_udata + : DW_FORM_sdata); + case dw_val_class_discr_list: + switch (constant_size (size_of_discr_list (AT_discr_list (a)))) + { + case 1: + return DW_FORM_block1; + case 2: + return DW_FORM_block2; + case 4: + return DW_FORM_block4; + default: + gcc_unreachable (); + } + default: gcc_unreachable (); } @@ -8914,6 +9144,17 @@ output_signature (const char *sig, const char *name) dw2_asm_output_data (1, sig[i], i == 0 ? "%s" : NULL, name); } +/* Output a discriminant value. */ + +static inline void +output_discr_value (dw_discr_value *discr_value, const char *name) +{ + if (discr_value->pos) + dw2_asm_output_data_uleb128 (discr_value->v.uval, "%s", name); + else + dw2_asm_output_data_sleb128 (discr_value->v.sval, "%s", name); +} + /* Output the DIE and its attributes. Called recursively to generate the definitions of each child DIE. */ @@ -9192,6 +9433,37 @@ output_die (dw_die_ref die) get_AT_low_pc (die), "DW_AT_high_pc"); break; + case dw_val_class_discr_value: + output_discr_value (&a->dw_attr_val.v.val_discr_value, name); + break; + + case dw_val_class_discr_list: + { + dw_discr_list_ref list = AT_discr_list (a); + const int size = size_of_discr_list (list); + + /* This is a block, so output its length first. */ + dw2_asm_output_data (constant_size (size), size, + "%s: block size", name); + + for (; list != NULL; list = list->dw_discr_next) + { + /* One byte for the discriminant value descriptor, and then as + many LEB128 numbers as required. */ + if (list->dw_discr_range) + dw2_asm_output_data (1, DW_DSC_range, + "%s: DW_DSC_range", name); + else + dw2_asm_output_data (1, DW_DSC_label, + "%s: DW_DSC_label", name); + + output_discr_value (&list->dw_discr_lower_bound, name); + if (list->dw_discr_range) + output_discr_value (&list->dw_discr_upper_bound, name); + } + break; + } + default: gcc_unreachable (); } @@ -11486,6 +11758,150 @@ int_loc_descriptor (HOST_WIDE_INT i) return new_loc_descr (op, i, 0); } +/* Likewise, for unsigned constants. */ + +static dw_loc_descr_ref +uint_loc_descriptor (unsigned HOST_WIDE_INT i) +{ + const unsigned HOST_WIDE_INT max_int = INTTYPE_MAXIMUM (HOST_WIDE_INT); + const unsigned HOST_WIDE_INT max_uint + = INTTYPE_MAXIMUM (unsigned HOST_WIDE_INT); + + /* If possible, use the clever signed constants handling. */ + if (i <= max_int) + return int_loc_descriptor ((HOST_WIDE_INT) i); + + /* Here, we are left with positive numbers that cannot be represented as + HOST_WIDE_INT, i.e.: + max (HOST_WIDE_INT) < i <= max (unsigned HOST_WIDE_INT) + + Using DW_OP_const4/8/./u operation to encode them consumes a lot of bytes + whereas may be better to output a negative integer: thanks to integer + wrapping, we know that: + x = x - 2 ** DWARF2_ADDR_SIZE + = x - 2 * (max (HOST_WIDE_INT) + 1) + So numbers close to max (unsigned HOST_WIDE_INT) could be represented as + small negative integers. Let's try that in cases it will clearly improve + the encoding: there is no gain turning DW_OP_const4u into + DW_OP_const4s. */ + if (DWARF2_ADDR_SIZE * 8 == HOST_BITS_PER_WIDE_INT + && ((DWARF2_ADDR_SIZE == 4 && i > max_uint - 0x8000) + || (DWARF2_ADDR_SIZE == 8 && i > max_uint - 0x80000000))) + { + const unsigned HOST_WIDE_INT first_shift = i - max_int - 1; + + /* Now, -1 < first_shift <= max (HOST_WIDE_INT) + i.e. 0 <= first_shift <= max (HOST_WIDE_INT). */ + const HOST_WIDE_INT second_shift + = (HOST_WIDE_INT) first_shift - (HOST_WIDE_INT) max_int - 1; + + /* So we finally have: + -max (HOST_WIDE_INT) - 1 <= second_shift <= -1. + i.e. min (HOST_WIDE_INT) <= second_shift < 0. */ + return int_loc_descriptor (second_shift); + } + + /* Last chance: fallback to a simple constant operation. */ + return new_loc_descr + ((HOST_BITS_PER_WIDE_INT == 32 || i <= 0xffffffff) + ? DW_OP_const4u + : DW_OP_const8u, + i, 0); +} + +/* Generate and return a location description that computes the unsigned + comparison of the two stack top entries (a OP b where b is the top-most + entry and a is the second one). The KIND of comparison can be LT_EXPR, + LE_EXPR, GT_EXPR or GE_EXPR. */ + +static dw_loc_descr_ref +uint_comparison_loc_list (enum tree_code kind) +{ + enum dwarf_location_atom op, flip_op; + dw_loc_descr_ref ret, bra_node, jmp_node, tmp; + + switch (kind) + { + case LT_EXPR: + op = DW_OP_lt; + break; + case LE_EXPR: + op = DW_OP_le; + break; + case GT_EXPR: + op = DW_OP_gt; + break; + case GE_EXPR: + op = DW_OP_ge; + break; + default: + gcc_unreachable (); + } + + bra_node = new_loc_descr (DW_OP_bra, 0, 0); + jmp_node = new_loc_descr (DW_OP_skip, 0, 0); + + /* DWARF operations all work on signed integers. It is nevertheless possible + to perform unsigned comparisons: we just have to distinguish three cases: + + 1. when a and b have the same sign (as signed integers); then we should + return: a OP(signed) b; + + 2. when a is a negative signed integer while b is a positive one, then a + is a greater unsigned integer than b; likewise when a and b's roles + are flipped. + + So first, compare the sign of the two operands. */ + ret = new_loc_descr (DW_OP_over, 0, 0); + add_loc_descr (&ret, new_loc_descr (DW_OP_over, 0, 0)); + add_loc_descr (&ret, new_loc_descr (DW_OP_xor, 0, 0)); + /* If they have different signs (i.e. they have different sign bits), then + the stack top value has now the sign bit set and thus it's smaller than + zero. */ + add_loc_descr (&ret, new_loc_descr (DW_OP_lit0, 0, 0)); + add_loc_descr (&ret, new_loc_descr (DW_OP_lt, 0, 0)); + add_loc_descr (&ret, bra_node); + + /* We are in case 1. At this point, we know both operands have the same + sign, to it's safe to use the built-in signed comparison. */ + add_loc_descr (&ret, new_loc_descr (op, 0, 0)); + add_loc_descr (&ret, jmp_node); + + /* We are in case 2. Here, we know both operands do not have the same sign, + so we have to flip the signed comparison. */ + flip_op = (kind == LT_EXPR || kind == LE_EXPR) ? DW_OP_gt : DW_OP_lt; + tmp = new_loc_descr (flip_op, 0, 0); + bra_node->dw_loc_oprnd1.val_class = dw_val_class_loc; + bra_node->dw_loc_oprnd1.v.val_loc = tmp; + add_loc_descr (&ret, tmp); + + /* This dummy operation is necessary to make the two branches join. */ + tmp = new_loc_descr (DW_OP_nop, 0, 0); + jmp_node->dw_loc_oprnd1.val_class = dw_val_class_loc; + jmp_node->dw_loc_oprnd1.v.val_loc = tmp; + add_loc_descr (&ret, tmp); + + return ret; +} + +/* Likewise, but takes the location description lists (might be destructive on + them). Return NULL if either is NULL or if concatenation fails. */ + +static dw_loc_list_ref +loc_list_from_uint_comparison (dw_loc_list_ref left, dw_loc_list_ref right, + enum tree_code kind) +{ + if (left == NULL || right == NULL) + return NULL; + + add_loc_list (&left, right); + if (left == NULL) + return NULL; + + add_loc_descr_to_each (left, uint_comparison_loc_list (kind)); + return left; +} + /* Return size_of_locs (int_shift_loc_descriptor (i, shift)) without actually allocating it. */ @@ -14531,6 +14947,68 @@ loc_list_for_address_of_addr_expr_of_indirect_ref (tree loc, bool toplev, return list_ret; } +/* Set LOC to the next operation that is not a DW_OP_nop operation. In the case + all operations from LOC are nops, move to the last one. Insert in NOPS all + operations that are skipped. */ + +static void +loc_descr_to_next_no_nop (dw_loc_descr_ref &loc, + hash_set &nops) +{ + while (loc->dw_loc_next != NULL && loc->dw_loc_opc == DW_OP_nop) + { + nops.add (loc); + loc = loc->dw_loc_next; + } +} + +/* Helper for loc_descr_without_nops: free the location description operation + P. */ +bool +free_loc_descr (const dw_loc_descr_ref &loc, void *data ATTRIBUTE_UNUSED) +{ + ggc_free (loc); + return true; +} + +/* Remove all DW_OP_nop operations from LOC except, if it exists, the one that + finishes LOC. */ + +static void +loc_descr_without_nops (dw_loc_descr_ref &loc) +{ + if (loc->dw_loc_opc == DW_OP_nop && loc->dw_loc_next == NULL) + return; + + /* ??? Set of all DW_OP_nop operations we remove: is it really a good thing + to free them, or should we instead let the garbage collect do it? */ + hash_set nops; + + /* First, strip all prefix NOP operations in order to keep the head of the + operations list. */ + loc_descr_to_next_no_nop (loc, nops); + + for (dw_loc_descr_ref cur = loc; cur != NULL;) + { + /* For control flow operations: strip "prefix" nops in destination + labels. */ + if (cur->dw_loc_oprnd1.val_class == dw_val_class_loc) + loc_descr_to_next_no_nop (cur->dw_loc_oprnd1.v.val_loc, nops); + if (cur->dw_loc_oprnd2.val_class == dw_val_class_loc) + loc_descr_to_next_no_nop (cur->dw_loc_oprnd2.v.val_loc, nops); + + /* Do the same for the operations that follow, then move to the next + iteration. */ + if (cur->dw_loc_next != NULL) + loc_descr_to_next_no_nop (cur->dw_loc_next, nops); + cur = cur->dw_loc_next; + } + + nops.traverse (NULL); +} + + +struct dwarf_procedure_info; /* Helper structure for location descriptions generation. */ struct loc_descr_context @@ -14542,61 +15020,507 @@ struct loc_descr_context /* The ..._DECL node that should be translated as a DW_OP_push_object_address operation. */ tree base_decl; + /* Information about the DWARF procedure we are currently generating. NULL if + we are not generating a DWARF procedure. */ + struct dwarf_procedure_info *dpi; }; -/* Generate Dwarf location list representing LOC. - If WANT_ADDRESS is false, expression computing LOC will be computed - If WANT_ADDRESS is 1, expression computing address of LOC will be returned - if WANT_ADDRESS is 2, expression computing address useable in location - will be returned (i.e. DW_OP_reg can be used - to refer to register values). +/* DWARF procedures generation - CONTEXT provides information to customize the location descriptions - generation. Its context_type field specifies what type is implicitly - referenced by DW_OP_push_object_address. If it is NULL_TREE, this operation - will not be generated. + DWARF expressions (aka. location descriptions) are used to encode variable + things such as sizes or offsets. Such computations can have redundant parts + that can be factorized in order to reduce the size of the output debug + information. This is the whole point of DWARF procedures. - If CONTEXT is NULL, the behavior is the same as if both context_type and - base_decl fields were NULL_TREE. */ + Thanks to stor-layout.c, size and offset expressions in GENERIC trees are + already factorized into functions ("size functions") in order to handle very + big and complex types. Such functions are quite simple: they have integral + arguments, they return an integral result and their body contains only a + return statement with arithmetic expressions. This is the only kind of + function we are interested in translating into DWARF procedures, here. -static dw_loc_list_ref -loc_list_from_tree (tree loc, int want_address, - const struct loc_descr_context *context) + DWARF expressions and DWARF procedure are executed using a stack, so we have + to define some calling convention for them to interact. Let's say that: + + - Before calling a DWARF procedure, DWARF expressions must push on the stack + all arguments in reverse order (right-to-left) so that when the DWARF + procedure execution starts, the first argument is the top of the stack. + + - Then, when returning, the DWARF procedure must have consumed all arguments + on the stack, must have pushed the result and touched nothing else. + + - Each integral argument and the result are integral types can be hold in a + single stack slot. + + - We call "frame offset" the number of stack slots that are "under DWARF + procedure control": it includes the arguments slots, the temporaries and + the result slot. Thus, it is equal to the number of arguments when the + procedure execution starts and must be equal to one (the result) when it + returns. */ + +/* Helper structure used when generating operations for a DWARF procedure. */ +struct dwarf_procedure_info { - dw_loc_descr_ref ret = NULL, ret1 = NULL; - dw_loc_list_ref list_ret = NULL, list_ret1 = NULL; - int have_address = 0; - enum dwarf_location_atom op; + /* The FUNCTION_DECL node corresponding to the DWARF procedure that is + currently translated. */ + tree fndecl; + /* The number of arguments FNDECL takes. */ + unsigned args_count; +}; - /* ??? Most of the time we do not take proper care for sign/zero - extending the values properly. Hopefully this won't be a real - problem... */ +/* Return a pointer to a newly created DIE node for a DWARF procedure. Add + LOCATION as its DW_AT_location attribute. If FNDECL is not NULL_TREE, + equate it to this DIE. */ - if (context != NULL - && context->base_decl == loc - && want_address == 0) - { - if (dwarf_version >= 3 || !dwarf_strict) - return new_loc_list (new_loc_descr (DW_OP_push_object_address, 0, 0), - NULL, NULL, NULL); - else - return NULL; - } +static dw_die_ref +new_dwarf_proc_die (dw_loc_descr_ref location, tree fndecl, + dw_die_ref parent_die) +{ + const bool dwarf_proc_supported = dwarf_version >= 4; + dw_die_ref dwarf_proc_die; - switch (TREE_CODE (loc)) + if ((dwarf_version < 3 && dwarf_strict) + || location == NULL) + return NULL; + + dwarf_proc_die = new_die (dwarf_proc_supported + ? DW_TAG_dwarf_procedure + : DW_TAG_variable, + parent_die, + fndecl); + if (fndecl) + equate_decl_number_to_die (fndecl, dwarf_proc_die); + if (!dwarf_proc_supported) + add_AT_flag (dwarf_proc_die, DW_AT_artificial, 1); + add_AT_loc (dwarf_proc_die, DW_AT_location, location); + return dwarf_proc_die; +} + +/* Return whether TYPE is a supported type as a DWARF procedure argument + type or return type (we handle only scalar types and pointer types that + aren't wider than the DWARF expression evaluation stack. */ + +static bool +is_handled_procedure_type (tree type) +{ + return ((INTEGRAL_TYPE_P (type) + || TREE_CODE (type) == OFFSET_TYPE + || TREE_CODE (type) == POINTER_TYPE) + && int_size_in_bytes (type) <= DWARF2_ADDR_SIZE); +} + +/* Make a DFS over operations reachable through LOC (i.e. follow branch + operations) in order to resolve the operand of DW_OP_pick operations that + target DWARF procedure arguments (DPI). Stop at already visited nodes. + INITIAL_FRAME_OFFSET is the frame offset *before* LOC is executed. Return + if all relocations were successful. */ + +static bool +resolve_args_picking (dw_loc_descr_ref loc, unsigned initial_frame_offset, + struct dwarf_procedure_info *dpi) +{ + /* The "frame_offset" identifier is already used to name a macro... */ + unsigned frame_offset_ = initial_frame_offset; + dw_loc_descr_ref l; + + for (l = loc; l != NULL;) { - case ERROR_MARK: - expansion_failed (loc, NULL_RTX, "ERROR_MARK"); - return 0; + /* If we already met this node, there is nothing to compute anymore. */ + if (l->dw_loc_frame_offset >= 0) + { + /* Make sure that the stack size is consistent wherever the execution + flow comes from. */ + gcc_assert ((unsigned) l->dw_loc_frame_offset == frame_offset_); + break; + } + l->dw_loc_frame_offset = frame_offset_; - case PLACEHOLDER_EXPR: - /* This case involves extracting fields from an object to determine the - position of other fields. It is supposed to appear only as the first - operand of COMPONENT_REF nodes and to reference precisely the type - that the context allows. */ - if (context != NULL - && TREE_TYPE (loc) == context->context_type - && want_address >= 1) + /* If needed, relocate the picking offset with respect to the frame + offset. */ + if (l->dw_loc_opc == DW_OP_pick && l->frame_offset_rel) + { + /* frame_offset_ is the size of the current stack frame, including + incoming arguments. Besides, the arguments are pushed + right-to-left. Thus, in order to access the Nth argument from + this operation node, the picking has to skip temporaries *plus* + one stack slot per argument (0 for the first one, 1 for the second + one, etc.). + + The targetted argument number (N) is already set as the operand, + and the number of temporaries can be computed with: + frame_offsets_ - dpi->args_count */ + l->dw_loc_oprnd1.v.val_unsigned += frame_offset_ - dpi->args_count; + + /* DW_OP_pick handles only offsets from 0 to 255 (inclusive)... */ + if (l->dw_loc_oprnd1.v.val_unsigned > 255) + return false; + } + + /* Update frame_offset according to the effect the current operation has + on the stack. */ + switch (l->dw_loc_opc) + { + case DW_OP_deref: + case DW_OP_swap: + case DW_OP_rot: + case DW_OP_abs: + case DW_OP_not: + case DW_OP_plus_uconst: + case DW_OP_skip: + case DW_OP_reg0: + case DW_OP_reg1: + case DW_OP_reg2: + case DW_OP_reg3: + case DW_OP_reg4: + case DW_OP_reg5: + case DW_OP_reg6: + case DW_OP_reg7: + case DW_OP_reg8: + case DW_OP_reg9: + case DW_OP_reg10: + case DW_OP_reg11: + case DW_OP_reg12: + case DW_OP_reg13: + case DW_OP_reg14: + case DW_OP_reg15: + case DW_OP_reg16: + case DW_OP_reg17: + case DW_OP_reg18: + case DW_OP_reg19: + case DW_OP_reg20: + case DW_OP_reg21: + case DW_OP_reg22: + case DW_OP_reg23: + case DW_OP_reg24: + case DW_OP_reg25: + case DW_OP_reg26: + case DW_OP_reg27: + case DW_OP_reg28: + case DW_OP_reg29: + case DW_OP_reg30: + case DW_OP_reg31: + case DW_OP_bregx: + case DW_OP_piece: + case DW_OP_deref_size: + case DW_OP_nop: + case DW_OP_form_tls_address: + case DW_OP_bit_piece: + case DW_OP_implicit_value: + case DW_OP_stack_value: + break; + + case DW_OP_addr: + case DW_OP_const1u: + case DW_OP_const1s: + case DW_OP_const2u: + case DW_OP_const2s: + case DW_OP_const4u: + case DW_OP_const4s: + case DW_OP_const8u: + case DW_OP_const8s: + case DW_OP_constu: + case DW_OP_consts: + case DW_OP_dup: + case DW_OP_over: + case DW_OP_pick: + case DW_OP_lit0: + case DW_OP_lit1: + case DW_OP_lit2: + case DW_OP_lit3: + case DW_OP_lit4: + case DW_OP_lit5: + case DW_OP_lit6: + case DW_OP_lit7: + case DW_OP_lit8: + case DW_OP_lit9: + case DW_OP_lit10: + case DW_OP_lit11: + case DW_OP_lit12: + case DW_OP_lit13: + case DW_OP_lit14: + case DW_OP_lit15: + case DW_OP_lit16: + case DW_OP_lit17: + case DW_OP_lit18: + case DW_OP_lit19: + case DW_OP_lit20: + case DW_OP_lit21: + case DW_OP_lit22: + case DW_OP_lit23: + case DW_OP_lit24: + case DW_OP_lit25: + case DW_OP_lit26: + case DW_OP_lit27: + case DW_OP_lit28: + case DW_OP_lit29: + case DW_OP_lit30: + case DW_OP_lit31: + case DW_OP_breg0: + case DW_OP_breg1: + case DW_OP_breg2: + case DW_OP_breg3: + case DW_OP_breg4: + case DW_OP_breg5: + case DW_OP_breg6: + case DW_OP_breg7: + case DW_OP_breg8: + case DW_OP_breg9: + case DW_OP_breg10: + case DW_OP_breg11: + case DW_OP_breg12: + case DW_OP_breg13: + case DW_OP_breg14: + case DW_OP_breg15: + case DW_OP_breg16: + case DW_OP_breg17: + case DW_OP_breg18: + case DW_OP_breg19: + case DW_OP_breg20: + case DW_OP_breg21: + case DW_OP_breg22: + case DW_OP_breg23: + case DW_OP_breg24: + case DW_OP_breg25: + case DW_OP_breg26: + case DW_OP_breg27: + case DW_OP_breg28: + case DW_OP_breg29: + case DW_OP_breg30: + case DW_OP_breg31: + case DW_OP_fbreg: + case DW_OP_push_object_address: + case DW_OP_call_frame_cfa: + ++frame_offset_; + break; + + case DW_OP_drop: + case DW_OP_xderef: + case DW_OP_and: + case DW_OP_div: + case DW_OP_minus: + case DW_OP_mod: + case DW_OP_mul: + case DW_OP_neg: + case DW_OP_or: + case DW_OP_plus: + case DW_OP_shl: + case DW_OP_shr: + case DW_OP_shra: + case DW_OP_xor: + case DW_OP_bra: + case DW_OP_eq: + case DW_OP_ge: + case DW_OP_gt: + case DW_OP_le: + case DW_OP_lt: + case DW_OP_ne: + case DW_OP_regx: + case DW_OP_xderef_size: + --frame_offset_; + break; + + case DW_OP_call2: + case DW_OP_call4: + case DW_OP_call_ref: + /* We can't predict the effect on the stack of the callee without + knowing the callee. That's why we rely on the call producer. */ + frame_offset_ += l->dw_loc_frame_offset_increment; + break; + + case DW_OP_GNU_push_tls_address: + case DW_OP_GNU_uninit: + case DW_OP_GNU_encoded_addr: + case DW_OP_GNU_implicit_pointer: + case DW_OP_GNU_entry_value: + case DW_OP_GNU_const_type: + case DW_OP_GNU_regval_type: + case DW_OP_GNU_deref_type: + case DW_OP_GNU_convert: + case DW_OP_GNU_reinterpret: + case DW_OP_GNU_parameter_ref: + /* loc_list_from_tree will probably not output these operations for + size functions, so assume they will not appear here. */ + /* Fall through... */ + + default: + gcc_unreachable (); + } + + /* Now, follow the control flow (except subroutine calls). */ + switch (l->dw_loc_opc) + { + case DW_OP_bra: + if (!resolve_args_picking (l->dw_loc_next, frame_offset_, dpi)) + return false; + /* Fall through... */ + + case DW_OP_skip: + l = l->dw_loc_oprnd1.v.val_loc; + break; + + case DW_OP_stack_value: + return true; + + default: + l = l->dw_loc_next; + break; + } + } + + return true; +} + +/* Try to generate a DWARF procedure that computes the same result as FNDECL. + Return NULL if it is not possible. */ + +static dw_die_ref +function_to_dwarf_procedure (tree fndecl) +{ + struct loc_descr_context ctx; + struct dwarf_procedure_info dpi; + dw_die_ref dwarf_proc_die; + tree tree_body = DECL_SAVED_TREE (fndecl); + dw_loc_descr_ref loc_body, epilogue; + + tree cursor; + unsigned i; + + /* Do not generate multiple DWARF procedures for the same function + declaration. */ + dwarf_proc_die = lookup_decl_die (fndecl); + if (dwarf_proc_die != NULL) + return dwarf_proc_die; + + /* DWARF procedures are available starting with the DWARFv3 standard, but + it's the DWARFv4 standard that introduces the DW_TAG_dwarf_procedure + DIE. */ + if (dwarf_version < 3 && dwarf_strict) + return NULL; + + /* We handle only functions for which we still have a body, that return a + supported type and that takes arguments with supported types. Note that + there is no point translating functions that return nothing. */ + if (tree_body == NULL_TREE + || DECL_RESULT (fndecl) == NULL_TREE + || !is_handled_procedure_type (TREE_TYPE (DECL_RESULT (fndecl)))) + return NULL; + + for (cursor = DECL_ARGUMENTS (fndecl); + cursor != NULL_TREE; + cursor = TREE_CHAIN (cursor)) + if (!is_handled_procedure_type (TREE_TYPE (cursor))) + return NULL; + + /* Match only "expr" in: RETURN_EXPR (MODIFY_EXPR (RESULT_DECL, expr)). */ + if (TREE_CODE (tree_body) != RETURN_EXPR) + return NULL; + tree_body = TREE_OPERAND (tree_body, 0); + if (TREE_CODE (tree_body) != MODIFY_EXPR + || TREE_OPERAND (tree_body, 0) != DECL_RESULT (fndecl)) + return NULL; + tree_body = TREE_OPERAND (tree_body, 1); + + /* Try to translate the body expression itself. Note that this will probably + cause an infinite recursion if its call graph has a cycle. This is very + unlikely for size functions, however, so don't bother with such things at + the moment. */ + ctx.context_type = NULL_TREE; + ctx.base_decl = NULL_TREE; + ctx.dpi = &dpi; + dpi.fndecl = fndecl; + dpi.args_count = list_length (DECL_ARGUMENTS (fndecl)); + loc_body = loc_descriptor_from_tree (tree_body, 0, &ctx); + if (!loc_body) + return NULL; + + /* After evaluating all operands in "loc_body", we should still have on the + stack all arguments plus the desired function result (top of the stack). + Generate code in order to keep only the result in our stack frame. */ + epilogue = NULL; + for (i = 0; i < dpi.args_count; ++i) + { + dw_loc_descr_ref op_couple = new_loc_descr (DW_OP_swap, 0, 0); + op_couple->dw_loc_next = new_loc_descr (DW_OP_drop, 0, 0); + op_couple->dw_loc_next->dw_loc_next = epilogue; + epilogue = op_couple; + } + add_loc_descr (&loc_body, epilogue); + if (!resolve_args_picking (loc_body, dpi.args_count, &dpi)) + return NULL; + + /* Trailing nops from loc_descritor_from_tree (if any) cannot be removed + because they are considered useful. Now there is an epilogue, they are + not anymore, so give it another try. */ + loc_descr_without_nops (loc_body); + + /* fndecl may be used both as a regular DW_TAG_subprogram DIE and as + a DW_TAG_dwarf_procedure, so we may have a conflict, here. It's unlikely, + though, given that size functions do not come from source, so they should + not have a dedicated DW_TAG_subprogram DIE. */ + dwarf_proc_die + = new_dwarf_proc_die (loc_body, fndecl, + get_context_die (DECL_CONTEXT (fndecl))); + + return dwarf_proc_die; +} + + +/* Generate Dwarf location list representing LOC. + If WANT_ADDRESS is false, expression computing LOC will be computed + If WANT_ADDRESS is 1, expression computing address of LOC will be returned + if WANT_ADDRESS is 2, expression computing address useable in location + will be returned (i.e. DW_OP_reg can be used + to refer to register values). + + CONTEXT provides information to customize the location descriptions + generation. Its context_type field specifies what type is implicitly + referenced by DW_OP_push_object_address. If it is NULL_TREE, this operation + will not be generated. + + Its DPI field determines whether we are generating a DWARF expression for a + DWARF procedure, so PARM_DECL references are processed specifically. + + If CONTEXT is NULL, the behavior is the same as if context_type, base_decl + and dpi fields were null. */ + +static dw_loc_list_ref +loc_list_from_tree_1 (tree loc, int want_address, + const struct loc_descr_context *context) +{ + dw_loc_descr_ref ret = NULL, ret1 = NULL; + dw_loc_list_ref list_ret = NULL, list_ret1 = NULL; + int have_address = 0; + enum dwarf_location_atom op; + + /* ??? Most of the time we do not take proper care for sign/zero + extending the values properly. Hopefully this won't be a real + problem... */ + + if (context != NULL + && context->base_decl == loc + && want_address == 0) + { + if (dwarf_version >= 3 || !dwarf_strict) + return new_loc_list (new_loc_descr (DW_OP_push_object_address, 0, 0), + NULL, NULL, NULL); + else + return NULL; + } + + switch (TREE_CODE (loc)) + { + case ERROR_MARK: + expansion_failed (loc, NULL_RTX, "ERROR_MARK"); + return 0; + + case PLACEHOLDER_EXPR: + /* This case involves extracting fields from an object to determine the + position of other fields. It is supposed to appear only as the first + operand of COMPONENT_REF nodes and to reference precisely the type + that the context allows. */ + if (context != NULL + && TREE_TYPE (loc) == context->context_type + && want_address >= 1) { if (dwarf_version >= 3 || !dwarf_strict) { @@ -14613,9 +15537,55 @@ loc_list_from_tree (tree loc, int want_address, break; case CALL_EXPR: - expansion_failed (loc, NULL_RTX, "CALL_EXPR"); - /* There are no opcodes for these operations. */ - return 0; + { + const int nargs = call_expr_nargs (loc); + tree callee = get_callee_fndecl (loc); + int i; + dw_die_ref dwarf_proc; + + if (callee == NULL_TREE) + goto call_expansion_failed; + + /* We handle only functions that return an integer. */ + if (!is_handled_procedure_type (TREE_TYPE (TREE_TYPE (callee)))) + goto call_expansion_failed; + + dwarf_proc = function_to_dwarf_procedure (callee); + if (dwarf_proc == NULL) + goto call_expansion_failed; + + /* Evaluate arguments right-to-left so that the first argument will + be the top-most one on the stack. */ + for (i = nargs - 1; i >= 0; --i) + { + dw_loc_descr_ref loc_descr + = loc_descriptor_from_tree (CALL_EXPR_ARG (loc, i), 0, + context); + + if (loc_descr == NULL) + goto call_expansion_failed; + + add_loc_descr (&ret, loc_descr); + } + + ret1 = new_loc_descr (DW_OP_call4, 0, 0); + ret1->dw_loc_oprnd1.val_class = dw_val_class_die_ref; + ret1->dw_loc_oprnd1.v.val_die_ref.die = dwarf_proc; + ret1->dw_loc_oprnd1.v.val_die_ref.external = 0; + + /* The called DWARF procedure consumes one stack slot per + argument and returns one stack slot. */ + ret1->dw_loc_frame_offset_increment = 1 - nargs; + + add_loc_descr (&ret, ret1); + + break; + + call_expansion_failed: + expansion_failed (loc, NULL_RTX, "CALL_EXPR"); + /* There are no opcodes for these operations. */ + return 0; + } case PREINCREMENT_EXPR: case PREDECREMENT_EXPR: @@ -14640,7 +15610,7 @@ loc_list_from_tree (tree loc, int want_address, } /* Otherwise, process the argument and look for the address. */ if (!list_ret && !ret) - list_ret = loc_list_from_tree (TREE_OPERAND (loc, 0), 1, context); + list_ret = loc_list_from_tree_1 (TREE_OPERAND (loc, 0), 1, context); else { if (want_address) @@ -14707,10 +15677,34 @@ loc_list_from_tree (tree loc, int want_address, /* FALLTHRU */ case PARM_DECL: + if (context != NULL && context->dpi != NULL + && DECL_CONTEXT (loc) == context->dpi->fndecl) + { + /* We are generating code for a DWARF procedure and we want to access + one of its arguments: find the appropriate argument offset and let + the resolve_args_picking pass compute the offset that complies + with the stack frame size. */ + unsigned i = 0; + tree cursor; + + for (cursor = DECL_ARGUMENTS (context->dpi->fndecl); + cursor != NULL_TREE && cursor != loc; + cursor = TREE_CHAIN (cursor), ++i) + ; + /* If we are translating a DWARF procedure, all referenced parameters + must belong to the current function. */ + gcc_assert (cursor != NULL_TREE); + + ret = new_loc_descr (DW_OP_pick, i, 0); + ret->frame_offset_rel = 1; + break; + } + /* FALLTHRU */ + case RESULT_DECL: if (DECL_HAS_VALUE_EXPR_P (loc)) - return loc_list_from_tree (DECL_VALUE_EXPR (loc), - want_address, context); + return loc_list_from_tree_1 (DECL_VALUE_EXPR (loc), + want_address, context); /* FALLTHRU */ case FUNCTION_DECL: @@ -14784,7 +15778,7 @@ loc_list_from_tree (tree loc, int want_address, } /* Fallthru. */ case INDIRECT_REF: - list_ret = loc_list_from_tree (TREE_OPERAND (loc, 0), 0, context); + list_ret = loc_list_from_tree_1 (TREE_OPERAND (loc, 0), 0, context); have_address = 1; break; @@ -14794,13 +15788,16 @@ loc_list_from_tree (tree loc, int want_address, return NULL; case COMPOUND_EXPR: - return loc_list_from_tree (TREE_OPERAND (loc, 1), want_address, context); + return loc_list_from_tree_1 (TREE_OPERAND (loc, 1), want_address, + context); CASE_CONVERT: case VIEW_CONVERT_EXPR: case SAVE_EXPR: case MODIFY_EXPR: - return loc_list_from_tree (TREE_OPERAND (loc, 0), want_address, context); + case NON_LVALUE_EXPR: + return loc_list_from_tree_1 (TREE_OPERAND (loc, 0), want_address, + context); case COMPONENT_REF: case BIT_FIELD_REF: @@ -14819,10 +15816,10 @@ loc_list_from_tree (tree loc, int want_address, gcc_assert (obj != loc); - list_ret = loc_list_from_tree (obj, - want_address == 2 - && !bitpos && !offset ? 2 : 1, - context); + list_ret = loc_list_from_tree_1 (obj, + want_address == 2 + && !bitpos && !offset ? 2 : 1, + context); /* TODO: We can extract value of the small expression via shifting even for nonzero bitpos. */ if (list_ret == 0) @@ -14837,7 +15834,7 @@ loc_list_from_tree (tree loc, int want_address, if (offset != NULL_TREE) { /* Variable offset. */ - list_ret1 = loc_list_from_tree (offset, 0, context); + list_ret1 = loc_list_from_tree_1 (offset, 0, context); if (list_ret1 == 0) return 0; add_loc_list (&list_ret, list_ret1); @@ -14868,6 +15865,8 @@ loc_list_from_tree (tree loc, int want_address, have_address = 1; else if (tree_fits_shwi_p (loc)) ret = int_loc_descriptor (tree_to_shwi (loc)); + else if (tree_fits_uhwi_p (loc)) + ret = uint_loc_descriptor (tree_to_uhwi (loc)); else { expansion_failed (loc, NULL_RTX, @@ -14909,6 +15908,7 @@ loc_list_from_tree (tree loc, int want_address, case CEIL_DIV_EXPR: case ROUND_DIV_EXPR: case TRUNC_DIV_EXPR: + case EXACT_DIV_EXPR: if (TYPE_UNSIGNED (TREE_TYPE (loc))) return 0; op = DW_OP_div; @@ -14927,8 +15927,8 @@ loc_list_from_tree (tree loc, int want_address, op = DW_OP_mod; goto do_binop; } - list_ret = loc_list_from_tree (TREE_OPERAND (loc, 0), 0, context); - list_ret1 = loc_list_from_tree (TREE_OPERAND (loc, 1), 0, context); + list_ret = loc_list_from_tree_1 (TREE_OPERAND (loc, 0), 0, context); + list_ret1 = loc_list_from_tree_1 (TREE_OPERAND (loc, 1), 0, context); if (list_ret == 0 || list_ret1 == 0) return 0; @@ -14959,11 +15959,49 @@ loc_list_from_tree (tree loc, int want_address, do_plus: if (tree_fits_shwi_p (TREE_OPERAND (loc, 1))) { - list_ret = loc_list_from_tree (TREE_OPERAND (loc, 0), 0, context); + /* Big unsigned numbers can fit in HOST_WIDE_INT but it may be + smarter to encode their opposite. The DW_OP_plus_uconst operation + takes 1 + X bytes, X being the size of the ULEB128 addend. On the + other hand, a "; DW_OP_minus" pattern takes 1 + Y + bytes, Y being the size of the operation that pushes the opposite + of the addend. So let's choose the smallest representation. */ + const tree tree_addend = TREE_OPERAND (loc, 1); + offset_int wi_addend; + HOST_WIDE_INT shwi_addend; + dw_loc_descr_ref loc_naddend; + + list_ret = loc_list_from_tree_1 (TREE_OPERAND (loc, 0), 0, context); if (list_ret == 0) return 0; - loc_list_plus_const (list_ret, tree_to_shwi (TREE_OPERAND (loc, 1))); + /* Try to get the literal to push. It is the opposite of the addend, + so as we rely on wrapping during DWARF evaluation, first decode + the literal as a "DWARF-sized" signed number. */ + wi_addend = wi::to_offset (tree_addend); + wi_addend = wi::sext (wi_addend, DWARF2_ADDR_SIZE * 8); + shwi_addend = wi_addend.to_shwi (); + loc_naddend = (shwi_addend != INTTYPE_MINIMUM (HOST_WIDE_INT)) + ? int_loc_descriptor (-shwi_addend) + : NULL; + + if (loc_naddend != NULL + && ((unsigned) size_of_uleb128 (shwi_addend) + > size_of_loc_descr (loc_naddend))) + { + add_loc_descr_to_each (list_ret, loc_naddend); + add_loc_descr_to_each (list_ret, + new_loc_descr (DW_OP_minus, 0, 0)); + } + else + { + for (dw_loc_descr_ref loc_cur = loc_naddend; loc_cur != NULL; ) + { + loc_naddend = loc_cur; + loc_cur = loc_cur->dw_loc_next; + ggc_free (loc_naddend); + } + loc_list_plus_const (list_ret, wi_addend.to_shwi ()); + } break; } @@ -14971,32 +16009,32 @@ loc_list_from_tree (tree loc, int want_address, goto do_binop; case LE_EXPR: - if (TYPE_UNSIGNED (TREE_TYPE (TREE_OPERAND (loc, 0)))) - return 0; - op = DW_OP_le; - goto do_binop; + goto do_comp_binop; case GE_EXPR: - if (TYPE_UNSIGNED (TREE_TYPE (TREE_OPERAND (loc, 0)))) - return 0; - op = DW_OP_ge; - goto do_binop; + goto do_comp_binop; case LT_EXPR: - if (TYPE_UNSIGNED (TREE_TYPE (TREE_OPERAND (loc, 0)))) - return 0; - op = DW_OP_lt; - goto do_binop; + goto do_comp_binop; case GT_EXPR: - if (TYPE_UNSIGNED (TREE_TYPE (TREE_OPERAND (loc, 0)))) - return 0; - op = DW_OP_gt; - goto do_binop; + goto do_comp_binop; + + do_comp_binop: + if (TYPE_UNSIGNED (TREE_TYPE (TREE_OPERAND (loc, 0)))) + { + list_ret = loc_list_from_tree (TREE_OPERAND (loc, 0), 0, context); + list_ret1 = loc_list_from_tree (TREE_OPERAND (loc, 1), 0, context); + list_ret = loc_list_from_uint_comparison (list_ret, list_ret1, + TREE_CODE (loc)); + break; + } + else + goto do_binop; case EQ_EXPR: op = DW_OP_eq; @@ -15007,8 +16045,8 @@ loc_list_from_tree (tree loc, int want_address, goto do_binop; do_binop: - list_ret = loc_list_from_tree (TREE_OPERAND (loc, 0), 0, context); - list_ret1 = loc_list_from_tree (TREE_OPERAND (loc, 1), 0, context); + list_ret = loc_list_from_tree_1 (TREE_OPERAND (loc, 0), 0, context); + list_ret1 = loc_list_from_tree_1 (TREE_OPERAND (loc, 1), 0, context); if (list_ret == 0 || list_ret1 == 0) return 0; @@ -15032,7 +16070,7 @@ loc_list_from_tree (tree loc, int want_address, goto do_unop; do_unop: - list_ret = loc_list_from_tree (TREE_OPERAND (loc, 0), 0, context); + list_ret = loc_list_from_tree_1 (TREE_OPERAND (loc, 0), 0, context); if (list_ret == 0) return 0; @@ -15058,10 +16096,10 @@ loc_list_from_tree (tree loc, int want_address, dw_loc_descr_ref lhs = loc_descriptor_from_tree (TREE_OPERAND (loc, 1), 0, context); dw_loc_list_ref rhs - = loc_list_from_tree (TREE_OPERAND (loc, 2), 0, context); + = loc_list_from_tree_1 (TREE_OPERAND (loc, 2), 0, context); dw_loc_descr_ref bra_node, jump_node, tmp; - list_ret = loc_list_from_tree (TREE_OPERAND (loc, 0), 0, context); + list_ret = loc_list_from_tree_1 (TREE_OPERAND (loc, 0), 0, context); if (list_ret == 0 || lhs == 0 || rhs == 0) return 0; @@ -15165,6 +16203,22 @@ loc_list_from_tree (tree loc, int want_address, return list_ret; } +/* Likewise, but strip useless DW_OP_nop operations in the resulting + expressions. */ + +static dw_loc_list_ref +loc_list_from_tree (tree loc, int want_address, + const struct loc_descr_context *context) +{ + dw_loc_list_ref result = loc_list_from_tree_1 (loc, want_address, context); + + for (dw_loc_list_ref loc_cur = result; + loc_cur != NULL; loc_cur = + loc_cur->dw_loc_next) + loc_descr_without_nops (loc_cur->expr); + return result; +} + /* Same as above but return only single location expression. */ static dw_loc_descr_ref loc_descriptor_from_tree (tree loc, int want_address, @@ -15235,34 +16289,91 @@ round_up_to_align (const offset_int &t, unsigned int align) return wi::udiv_trunc (t + align - 1, align) * align; } -/* Given a pointer to a FIELD_DECL, compute and return the byte offset of the - lowest addressed byte of the "containing object" for the given FIELD_DECL, - or return 0 if we are unable to determine what that offset is, either - because the argument turns out to be a pointer to an ERROR_MARK node, or - because the offset is actually variable. (We can't handle the latter case - just yet). */ +/* Compute the size of TYPE in bytes. If possible, return NULL and store the + size as an integer constant in CST_SIZE. Otherwise, if possible, return a + DWARF expression that computes the size. Return NULL and set CST_SIZE to -1 + if we fail to return the size in one of these two forms. */ -static HOST_WIDE_INT -field_byte_offset (const_tree decl) +static dw_loc_descr_ref +type_byte_size (const_tree type, HOST_WIDE_INT *cst_size) +{ + tree tree_size; + struct loc_descr_context ctx; + + /* Return a constant integer in priority, if possible. */ + *cst_size = int_size_in_bytes (type); + if (*cst_size != -1) + return NULL; + + ctx.context_type = const_cast (type); + ctx.base_decl = NULL_TREE; + ctx.dpi = NULL; + + type = TYPE_MAIN_VARIANT (type); + tree_size = TYPE_SIZE_UNIT (type); + return ((tree_size != NULL_TREE) + ? loc_descriptor_from_tree (tree_size, 0, &ctx) + : NULL); +} + +/* Helper structure for RECORD_TYPE processing. */ +struct vlr_context +{ + /* Root RECORD_TYPE. It is needed to generate data member location + descriptions in variable-length records (VLR), but also to cope with + variants, which are composed of nested structures multiplexed with + QUAL_UNION_TYPE nodes. Each time such a structure is passed to a + function processing a FIELD_DECL, it is required to be non null. */ + tree struct_type; + /* When generating a variant part in a RECORD_TYPE (i.e. a nested + QUAL_UNION_TYPE), this holds an expression that computes the offset for + this variant part as part of the root record (in storage units). For + regular records, it must be NULL_TREE. */ + tree variant_part_offset; +}; + +/* Given a pointer to a FIELD_DECL, compute the byte offset of the lowest + addressed byte of the "containing object" for the given FIELD_DECL. If + possible, return a native constant through CST_OFFSET (in which case NULL is + returned); otherwise return a DWARF expression that computes the offset. + + Set *CST_OFFSET to 0 and return NULL if we are unable to determine what + that offset is, either because the argument turns out to be a pointer to an + ERROR_MARK node, or because the offset expression is too complex for us. + + CTX is required: see the comment for VLR_CONTEXT. */ + +static dw_loc_descr_ref +field_byte_offset (const_tree decl, struct vlr_context *ctx, + HOST_WIDE_INT *cst_offset) { offset_int object_offset_in_bits; offset_int object_offset_in_bytes; offset_int bitpos_int; + bool is_byte_offset_cst, is_bit_offset_cst; + tree tree_result; + dw_loc_list_ref loc_result; - if (TREE_CODE (decl) == ERROR_MARK) - return 0; + *cst_offset = 0; - gcc_assert (TREE_CODE (decl) == FIELD_DECL); + if (TREE_CODE (decl) == ERROR_MARK) + return NULL; + else + gcc_assert (TREE_CODE (decl) == FIELD_DECL); - /* We cannot yet cope with fields whose positions are variable, so - for now, when we see such things, we simply return 0. Someday, we may - be able to handle such cases, but it will be damn difficult. */ - if (TREE_CODE (bit_position (decl)) != INTEGER_CST) - return 0; + is_bit_offset_cst = TREE_CODE (DECL_FIELD_BIT_OFFSET (decl)) != INTEGER_CST; + is_byte_offset_cst = TREE_CODE (DECL_FIELD_OFFSET (decl)) != INTEGER_CST; - bitpos_int = wi::to_offset (bit_position (decl)); + /* We cannot handle variable bit offsets at the moment, so abort if it's the + case. */ + if (is_bit_offset_cst) + return NULL; - if (PCC_BITFIELD_TYPE_MATTERS) +#ifdef PCC_BITFIELD_TYPE_MATTERS + /* We used to handle only constant offsets in all cases. Now, we handle + properly dynamic byte offsets only when PCC bitfield type doesn't + matter. */ + if (PCC_BITFIELD_TYPE_MATTERS && is_byte_offset_cst && is_bit_offset_cst) { tree type; tree field_size_tree; @@ -15272,6 +16383,7 @@ field_byte_offset (const_tree decl) unsigned int decl_align_in_bits; offset_int type_size_in_bits; + bitpos_int = wi::to_offset (bit_position (decl)); type = field_type (decl); type_size_in_bits = offset_int_type_size_in_bits (type); type_align_in_bits = simple_type_align_in_bits (type); @@ -15358,12 +16470,33 @@ field_byte_offset (const_tree decl) = round_up_to_align (object_offset_in_bits, decl_align_in_bits); } } - else - object_offset_in_bits = bitpos_int; +#endif /* PCC_BITFIELD_TYPE_MATTERS */ + + tree_result = byte_position (decl); + if (ctx->variant_part_offset != NULL_TREE) + tree_result = fold (build2 (PLUS_EXPR, TREE_TYPE (tree_result), + ctx->variant_part_offset, tree_result)); + + /* If the byte offset is a constant, it's simplier to handle a native + constant rather than a DWARF expression. */ + if (TREE_CODE (tree_result) == INTEGER_CST) + { + *cst_offset = wi::to_offset (tree_result).to_shwi (); + return NULL; + } + struct loc_descr_context loc_ctx = { + ctx->struct_type, /* context_type */ + NULL_TREE, /* base_decl */ + NULL /* dpi */ + }; + loc_result = loc_list_from_tree (tree_result, 0, &loc_ctx); - object_offset_in_bytes - = wi::lrshift (object_offset_in_bits, LOG2_BITS_PER_UNIT); - return object_offset_in_bytes.to_shwi (); + /* We want a DWARF expression: abort if we only have a location list with + multiple elements. */ + if (!loc_result || !single_element_loc_list_p (loc_result)) + return NULL; + else + return loc_result->expr; } /* The following routines define various Dwarf attributes and any data @@ -15427,10 +16560,14 @@ add_accessibility_attribute (dw_die_ref die, tree decl) DW_AT_byte_size attribute for this bit-field. (See the `byte_size_attribute' function below.) It is also used when calculating the value of the DW_AT_bit_offset attribute. (See the `bit_offset_attribute' - function below.) */ + function below.) + + CTX is required: see the comment for VLR_CONTEXT. */ static void -add_data_member_location_attribute (dw_die_ref die, tree decl) +add_data_member_location_attribute (dw_die_ref die, + tree decl, + struct vlr_context *ctx) { HOST_WIDE_INT offset; dw_loc_descr_ref loc_descr = 0; @@ -15480,7 +16617,23 @@ add_data_member_location_attribute (dw_die_ref die, tree decl) offset = tree_to_shwi (BINFO_OFFSET (decl)); } else - offset = field_byte_offset (decl); + { + loc_descr = field_byte_offset (decl, ctx, &offset); + + /* Data member location evalutation start with the base address on the + stack. Compute the field offset and add it to this base address. */ + if (loc_descr != NULL) + add_loc_descr (&loc_descr, new_loc_descr (DW_OP_plus, 0, 0)); + } + + /* If loc_descr is available then we know the field offset is dynamic. + However, GDB does not handle dynamic field offsets very well at the + moment. */ + if (loc_descr != NULL && gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL) + { + loc_descr = NULL; + offset = 0; + } if (! loc_descr) { @@ -16925,6 +18078,14 @@ add_bound_info (dw_die_ref subrange_die, enum dwarf_attribute bound_attr, /* FALLTHRU */ default: + /* Because of the complex interaction there can be with other GNAT + encodings, GDB isn't ready yet to handle proper DWARF description + for self-referencial subrange bounds: let GNAT encodings do the + magic in such a case. */ + if (gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL + && contains_placeholder_p (bound)) + return; + add_scalar_info (subrange_die, bound_attr, bound, dw_scalar_form_constant | dw_scalar_form_exprloc @@ -17041,6 +18202,7 @@ add_byte_size_attribute (dw_die_ref die, tree tree_node) { dw_die_ref decl_die; HOST_WIDE_INT size; + dw_loc_descr_ref size_expr = NULL; switch (TREE_CODE (tree_node)) { @@ -17057,7 +18219,7 @@ add_byte_size_attribute (dw_die_ref die, tree tree_node) add_AT_die_ref (die, DW_AT_byte_size, decl_die); return; } - size = int_size_in_bytes (tree_node); + size_expr = type_byte_size (tree_node, &size); break; case FIELD_DECL: /* For a data member of a struct or union, the DW_AT_byte_size is @@ -17070,10 +18232,17 @@ add_byte_size_attribute (dw_die_ref die, tree tree_node) gcc_unreachable (); } + /* Support for dynamically-sized objects was introduced by DWARFv3. + At the moment, GDB does not handle variable byte sizes very well, + though. */ + if ((dwarf_version >= 3 || !dwarf_strict) + && gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL + && size_expr != NULL) + add_AT_loc (die, DW_AT_byte_size, size_expr); + /* Note that `size' might be -1 when we get to this point. If it is, that - indicates that the byte size of the entity in question is variable. We - have no good way of expressing this fact in Dwarf at the present time, - when location description was not used by the caller code instead. */ + indicates that the byte size of the entity in question is variable and + that we could not generate a DWARF expression that computes it. */ if (size >= 0) add_AT_unsigned (die, DW_AT_byte_size, size); } @@ -17090,22 +18259,26 @@ add_byte_size_attribute (dw_die_ref die, tree tree_node) exact location of the "containing object" for a bit-field is rather complicated. It's handled by the `field_byte_offset' function (above). + CTX is required: see the comment for VLR_CONTEXT. + Note that it is the size (in bytes) of the hypothetical "containing object" which will be given in the DW_AT_byte_size attribute for this bit-field. (See `byte_size_attribute' above). */ static inline void -add_bit_offset_attribute (dw_die_ref die, tree decl) +add_bit_offset_attribute (dw_die_ref die, tree decl, struct vlr_context *ctx) { - HOST_WIDE_INT object_offset_in_bytes = field_byte_offset (decl); - tree type = DECL_BIT_FIELD_TYPE (decl); + HOST_WIDE_INT object_offset_in_bytes; + tree original_type = DECL_BIT_FIELD_TYPE (decl); HOST_WIDE_INT bitpos_int; HOST_WIDE_INT highest_order_object_bit_offset; HOST_WIDE_INT highest_order_field_bit_offset; HOST_WIDE_INT bit_offset; + field_byte_offset (decl, ctx, &object_offset_in_bytes); + /* Must be a field and a bit field. */ - gcc_assert (type && TREE_CODE (decl) == FIELD_DECL); + gcc_assert (original_type && TREE_CODE (decl) == FIELD_DECL); /* We can't yet handle bit-fields whose offsets are variable, so if we encounter such things, just return without generating any attribute @@ -17127,7 +18300,8 @@ add_bit_offset_attribute (dw_die_ref die, tree decl) if (! BYTES_BIG_ENDIAN) { highest_order_field_bit_offset += tree_to_shwi (DECL_SIZE (decl)); - highest_order_object_bit_offset += simple_type_size_in_bits (type); + highest_order_object_bit_offset += + simple_type_size_in_bits (original_type); } bit_offset @@ -17337,6 +18511,44 @@ add_name_and_src_coords_attributes (dw_die_ref die, tree decl) #endif /* VMS_DEBUGGING_INFO */ } +/* Add VALUE as a DW_AT_discr_value attribute to DIE. */ + +static void +add_discr_value (dw_die_ref die, dw_discr_value *value) +{ + dw_attr_node attr; + + attr.dw_attr = DW_AT_discr_value; + attr.dw_attr_val.val_class = dw_val_class_discr_value; + attr.dw_attr_val.val_entry = NULL; + attr.dw_attr_val.v.val_discr_value.pos = value->pos; + if (value->pos) + attr.dw_attr_val.v.val_discr_value.v.uval = value->v.uval; + else + attr.dw_attr_val.v.val_discr_value.v.sval = value->v.sval; + add_dwarf_attr (die, &attr); +} + +/* Add DISCR_LIST as a DW_AT_discr_list to DIE. */ + +static void +add_discr_list (dw_die_ref die, dw_discr_list_ref discr_list) +{ + dw_attr_node attr; + + attr.dw_attr = DW_AT_discr_list; + attr.dw_attr_val.val_class = dw_val_class_discr_list; + attr.dw_attr_val.val_entry = NULL; + attr.dw_attr_val.v.val_discr_list = discr_list; + add_dwarf_attr (die, &attr); +} + +static inline dw_discr_list_ref +AT_discr_list (dw_attr_node *attr) +{ + return attr->dw_attr_val.v.val_discr_list; +} + #ifdef VMS_DEBUGGING_INFO /* Output the debug main pointer die for VMS */ @@ -17796,7 +19008,7 @@ gen_descr_array_type_die (tree type, struct array_descr_info *info, { const dw_die_ref scope_die = scope_die_for (type, context_die); const dw_die_ref array_die = new_die (DW_TAG_array_type, scope_die, type); - const struct loc_descr_context context = { type, info->base_decl }; + const struct loc_descr_context context = { type, info->base_decl, NULL }; int dim; add_name_attribute (array_die, type_tag (type)); @@ -18315,8 +19527,12 @@ gen_type_die_for_member (tree type, tree member, dw_die_ref context_die) || TREE_CODE (TREE_TYPE (member)) == UNION_TYPE || TREE_CODE (TREE_TYPE (member)) == RECORD_TYPE) { + struct vlr_context vlr_ctx = { + DECL_CONTEXT (member), /* struct_type */ + NULL_TREE /* variant_part_offset */ + }; gen_type_die (member_declared_type (member), type_die); - gen_field_die (member, type_die); + gen_field_die (member, &vlr_ctx, type_die); } } else @@ -19176,7 +20392,7 @@ gen_subprogram_die (tree decl, dw_die_ref context_die) &parm); else if (parm && !POINTER_BOUNDS_P (parm)) { - dw_die_ref parm_die = gen_decl_die (parm, NULL, subr_die); + dw_die_ref parm_die = gen_decl_die (parm, NULL, NULL, subr_die); if (parm == DECL_ARGUMENTS (decl) && TREE_CODE (TREE_TYPE (decl)) == METHOD_TYPE @@ -19238,7 +20454,7 @@ gen_subprogram_die (tree decl, dw_die_ref context_die) /* Emit a DW_TAG_variable DIE for a named return value. */ if (DECL_NAME (DECL_RESULT (decl))) - gen_decl_die (DECL_RESULT (decl), NULL, subr_die); + gen_decl_die (DECL_RESULT (decl), NULL, NULL, subr_die); /* The first time through decls_for_scope we will generate the DIEs for the locals. The second time, we fill in the @@ -19989,10 +21205,11 @@ gen_inlined_subroutine_die (tree stmt, dw_die_ref context_die) } } -/* Generate a DIE for a field in a record, or structure. */ +/* Generate a DIE for a field in a record, or structure. CTX is required: see + the comment for VLR_CONTEXT. */ static void -gen_field_die (tree decl, dw_die_ref context_die) +gen_field_die (tree decl, struct vlr_context *ctx, dw_die_ref context_die) { dw_die_ref decl_die; @@ -20008,11 +21225,16 @@ gen_field_die (tree decl, dw_die_ref context_die) { add_byte_size_attribute (decl_die, decl); add_bit_size_attribute (decl_die, decl); - add_bit_offset_attribute (decl_die, decl); + add_bit_offset_attribute (decl_die, decl, ctx); } + /* If we have a variant part offset, then we are supposed to process a member + of a QUAL_UNION_TYPE, which is how we represent variant parts in + trees. */ + gcc_assert (ctx->variant_part_offset == NULL_TREE + || TREE_CODE (DECL_FIELD_CONTEXT (decl)) != QUAL_UNION_TYPE); if (TREE_CODE (DECL_FIELD_CONTEXT (decl)) != UNION_TYPE) - add_data_member_location_attribute (decl_die, decl); + add_data_member_location_attribute (decl_die, decl, ctx); if (DECL_ARTIFICIAL (decl)) add_AT_flag (decl_die, DW_AT_artificial, 1); @@ -20337,12 +21559,14 @@ gen_compile_unit_die (const char *filename) /* Generate the DIE for a base class. */ static void -gen_inheritance_die (tree binfo, tree access, dw_die_ref context_die) +gen_inheritance_die (tree binfo, tree access, tree type, + dw_die_ref context_die) { dw_die_ref die = new_die (DW_TAG_inheritance, context_die, binfo); + struct vlr_context ctx = { type, NULL }; add_type_attribute (die, BINFO_TYPE (binfo), TYPE_UNQUALIFIED, context_die); - add_data_member_location_attribute (die, binfo); + add_data_member_location_attribute (die, binfo, &ctx); if (BINFO_VIRTUAL_P (binfo)) add_AT_unsigned (die, DW_AT_virtuality, DW_VIRTUALITY_virtual); @@ -20363,6 +21587,407 @@ gen_inheritance_die (tree binfo, tree access, dw_die_ref context_die) add_AT_unsigned (die, DW_AT_accessibility, DW_ACCESS_private); } +/* Return whether DECL is a FIELD_DECL that represents the variant part of a + structure. */ +static bool +is_variant_part (tree decl) +{ + return (TREE_CODE (decl) == FIELD_DECL + && TREE_CODE (TREE_TYPE (decl)) == QUAL_UNION_TYPE); +} + +/* Check that OPERAND is a reference to a field in STRUCT_TYPE. If it is, + return the FIELD_DECL. Return NULL_TREE otherwise. */ + +static tree +analyze_discr_in_predicate (tree operand, tree struct_type) +{ + bool continue_stripping = true; + while (continue_stripping) + switch (TREE_CODE (operand)) + { + CASE_CONVERT: + operand = TREE_OPERAND (operand, 0); + break; + default: + continue_stripping = false; + break; + } + + /* Match field access to members of struct_type only. */ + if (TREE_CODE (operand) == COMPONENT_REF + && TREE_CODE (TREE_OPERAND (operand, 0)) == PLACEHOLDER_EXPR + && TREE_TYPE (TREE_OPERAND (operand, 0)) == struct_type + && TREE_CODE (TREE_OPERAND (operand, 1)) == FIELD_DECL) + return TREE_OPERAND (operand, 1); + else + return NULL_TREE; +} + +/* Check that SRC is a constant integer that can be represented as a native + integer constant (either signed or unsigned). If so, store it into DEST and + return true. Return false otherwise. */ + +static bool +get_discr_value (tree src, dw_discr_value *dest) +{ + bool is_unsigned = TYPE_UNSIGNED (TREE_TYPE (src)); + + if (TREE_CODE (src) != INTEGER_CST + || !(is_unsigned ? tree_fits_uhwi_p (src) : tree_fits_shwi_p (src))) + return false; + + dest->pos = is_unsigned; + if (is_unsigned) + dest->v.uval = tree_to_uhwi (src); + else + dest->v.sval = tree_to_shwi (src); + + return true; +} + +/* Try to extract synthetic properties out of VARIANT_PART_DECL, which is a + FIELD_DECL in STRUCT_TYPE that represents a variant part. If unsuccessful, + store NULL_TREE in DISCR_DECL. Otherwise: + + - store the discriminant field in STRUCT_TYPE that controls the variant + part to *DISCR_DECL + + - put in *DISCR_LISTS_P an array where for each variant, the item + represents the corresponding matching list of discriminant values. + + - put in *DISCR_LISTS_LENGTH the number of variants, which is the size of + the above array. + + Note that when the array is allocated (i.e. when the analysis is + successful), it is up to the caller to free the array. */ + +static void +analyze_variants_discr (tree variant_part_decl, + tree struct_type, + tree *discr_decl, + dw_discr_list_ref **discr_lists_p, + unsigned *discr_lists_length) +{ + tree variant_part_type = TREE_TYPE (variant_part_decl); + tree variant; + dw_discr_list_ref *discr_lists; + unsigned i; + + /* Compute how many variants there are in this variant part. */ + *discr_lists_length = 0; + for (variant = TYPE_FIELDS (variant_part_type); + variant != NULL_TREE; + variant = DECL_CHAIN (variant)) + ++*discr_lists_length; + + *discr_decl = NULL_TREE; + *discr_lists_p + = (dw_discr_list_ref *) xcalloc (*discr_lists_length, + sizeof (**discr_lists_p)); + discr_lists = *discr_lists_p; + + /* And then analyze all variants to extract discriminant information for all + of them. This analysis is conservative: as soon as we detect something we + do not support, abort everything and pretend we found nothing. */ + for (variant = TYPE_FIELDS (variant_part_type), i = 0; + variant != NULL_TREE; + variant = DECL_CHAIN (variant), ++i) + { + tree match_expr = DECL_QUALIFIER (variant); + + /* Now, try to analyze the predicate and deduce a discriminant for + it. */ + if (match_expr == boolean_true_node) + /* Typically happens for the default variant: it matches all cases that + previous variants rejected. Don't output any matching value for + this one. */ + continue; + + /* The following loop tries to iterate over each discriminant + possibility: single values or ranges. */ + while (match_expr != NULL_TREE) + { + tree next_round_match_expr; + tree candidate_discr = NULL_TREE; + dw_discr_list_ref new_node = NULL; + + /* Possibilities are matched one after the other by nested + TRUTH_ORIF_EXPR expressions. Process the current possibility and + continue with the rest at next iteration. */ + if (TREE_CODE (match_expr) == TRUTH_ORIF_EXPR) + { + next_round_match_expr = TREE_OPERAND (match_expr, 0); + match_expr = TREE_OPERAND (match_expr, 1); + } + else + next_round_match_expr = NULL_TREE; + + if (match_expr == boolean_false_node) + /* This sub-expression matches nothing: just wait for the next + one. */ + ; + + else if (TREE_CODE (match_expr) == EQ_EXPR) + { + /* We are matching: == + This sub-expression matches a single value. */ + tree integer_cst = TREE_OPERAND (match_expr, 1); + + candidate_discr + = analyze_discr_in_predicate (TREE_OPERAND (match_expr, 0), + struct_type); + + new_node = ggc_cleared_alloc (); + if (!get_discr_value (integer_cst, + &new_node->dw_discr_lower_bound)) + goto abort; + new_node->dw_discr_range = false; + } + + else if (TREE_CODE (match_expr) == TRUTH_ANDIF_EXPR) + { + /* We are matching: + > + && < . + This sub-expression matches the range of values between the + two matched integer constants. Note that comparisons can be + inclusive or exclusive. */ + tree candidate_discr_1, candidate_discr_2; + tree lower_cst, upper_cst; + bool lower_cst_included, upper_cst_included; + tree lower_op = TREE_OPERAND (match_expr, 0); + tree upper_op = TREE_OPERAND (match_expr, 1); + + /* When the comparison is exclusive, the integer constant is not + the discriminant range bound we are looking for: we will have + to increment or decrement it. */ + if (TREE_CODE (lower_op) == GE_EXPR) + lower_cst_included = true; + else if (TREE_CODE (lower_op) == GT_EXPR) + lower_cst_included = false; + else + goto abort; + + if (TREE_CODE (upper_op) == LE_EXPR) + upper_cst_included = true; + else if (TREE_CODE (upper_op) == LT_EXPR) + upper_cst_included = false; + else + goto abort; + + /* Extract the discriminant from the first operand and check it + is consistant with the same analysis in the second + operand. */ + candidate_discr_1 + = analyze_discr_in_predicate (TREE_OPERAND (lower_op, 0), + struct_type); + candidate_discr_2 + = analyze_discr_in_predicate (TREE_OPERAND (upper_op, 0), + struct_type); + if (candidate_discr_1 == candidate_discr_2) + candidate_discr = candidate_discr_1; + else + goto abort; + + /* Extract bounds from both. */ + new_node = ggc_cleared_alloc (); + lower_cst = TREE_OPERAND (lower_op, 1); + upper_cst = TREE_OPERAND (upper_op, 1); + + if (!lower_cst_included) + lower_cst + = fold (build2 (PLUS_EXPR, TREE_TYPE (lower_cst), + lower_cst, + build_int_cst (TREE_TYPE (lower_cst), 1))); + if (!upper_cst_included) + upper_cst + = fold (build2 (MINUS_EXPR, TREE_TYPE (upper_cst), + upper_cst, + build_int_cst (TREE_TYPE (upper_cst), 1))); + + if (!get_discr_value (lower_cst, + &new_node->dw_discr_lower_bound) + || !get_discr_value (upper_cst, + &new_node->dw_discr_upper_bound)) + goto abort; + + new_node->dw_discr_range = true; + } + + else + /* Unsupported sub-expression: we cannot determine the set of + matching discriminant values. Abort everything. */ + goto abort; + + /* If the discriminant info is not consistant with what we saw so + far, consider the analysis failed and abort everything. */ + if (candidate_discr == NULL_TREE + || (*discr_decl != NULL_TREE && candidate_discr != *discr_decl)) + goto abort; + else + *discr_decl = candidate_discr; + + if (new_node != NULL) + { + new_node->dw_discr_next = discr_lists[i]; + discr_lists[i] = new_node; + } + match_expr = next_round_match_expr; + } + } + + /* If we reach this point, we could match everything we were interested + in. */ + return; + +abort: + /* Clean all data structure and return no result. */ + free (*discr_lists_p); + *discr_lists_p = NULL; + *discr_decl = NULL_TREE; +} + +/* Generate a DIE to represent VARIANT_PART_DECL, a variant part that is part + of STRUCT_TYPE, a record type. This new DIE is emitted as the next child + under CONTEXT_DIE. + + Variant parts are supposed to be implemented as a FIELD_DECL whose type is a + QUAL_UNION_TYPE: this is the VARIANT_PART_DECL parameter. The members for + this type, which are record types, represent the available variants and each + has a DECL_QUALIFIER attribute. The discriminant and the discriminant + values are inferred from these attributes. + + In trees, the offsets for the fields inside these sub-records are relative + to the variant part itself, whereas the corresponding DIEs should have + offset attributes that are relative to the embedding record base address. + This is why the caller must provide a VARIANT_PART_OFFSET expression: it + must be an expression that computes the offset of the variant part to + describe in DWARF. */ + +static void +gen_variant_part (tree variant_part_decl, struct vlr_context *vlr_ctx, + dw_die_ref context_die) +{ + const tree variant_part_type = TREE_TYPE (variant_part_decl); + tree variant_part_offset = vlr_ctx->variant_part_offset; + struct loc_descr_context ctx = { + vlr_ctx->struct_type, /* context_type */ + NULL_TREE, /* base_decl */ + NULL /* dpi */ + }; + + /* The FIELD_DECL node in STRUCT_TYPE that acts as the discriminant, or + NULL_TREE if there is no such field. */ + tree discr_decl = NULL_TREE; + dw_discr_list_ref *discr_lists; + unsigned discr_lists_length = 0; + unsigned i; + + dw_die_ref dwarf_proc_die = NULL; + dw_die_ref variant_part_die + = new_die (DW_TAG_variant_part, context_die, variant_part_type); + + equate_decl_number_to_die (variant_part_decl, variant_part_die); + + analyze_variants_discr (variant_part_decl, vlr_ctx->struct_type, + &discr_decl, &discr_lists, &discr_lists_length); + + if (discr_decl != NULL_TREE) + { + dw_die_ref discr_die = lookup_decl_die (discr_decl); + + if (discr_die) + add_AT_die_ref (variant_part_die, DW_AT_discr, discr_die); + else + /* We have no DIE for the discriminant, so just discard all + discrimimant information in the output. */ + discr_decl = NULL_TREE; + } + + /* If the offset for this variant part is more complex than a constant, + create a DWARF procedure for it so that we will not have to generate DWARF + expressions for it for each member. */ + if (TREE_CODE (variant_part_offset) != INTEGER_CST + && (dwarf_version >= 3 || !dwarf_strict)) + { + const tree dwarf_proc_fndecl + = build_decl (UNKNOWN_LOCATION, FUNCTION_DECL, NULL_TREE, + build_function_type (TREE_TYPE (variant_part_offset), + NULL_TREE)); + const tree dwarf_proc_call = build_call_expr (dwarf_proc_fndecl, 0); + const dw_loc_descr_ref dwarf_proc_body + = loc_descriptor_from_tree (variant_part_offset, 0, &ctx); + + dwarf_proc_die = new_dwarf_proc_die (dwarf_proc_body, + dwarf_proc_fndecl, context_die); + if (dwarf_proc_die != NULL) + variant_part_offset = dwarf_proc_call; + } + + /* Output DIEs for all variants. */ + i = 0; + for (tree variant = TYPE_FIELDS (variant_part_type); + variant != NULL_TREE; + variant = DECL_CHAIN (variant), ++i) + { + tree variant_type = TREE_TYPE (variant); + dw_die_ref variant_die; + + /* All variants (i.e. members of a variant part) are supposed to be + encoded as structures. Sub-variant parts are QUAL_UNION_TYPE fields + under these records. */ + gcc_assert (TREE_CODE (variant_type) == RECORD_TYPE); + + variant_die = new_die (DW_TAG_variant, variant_part_die, variant_type); + equate_decl_number_to_die (variant, variant_die); + + /* Output discriminant values this variant matches, if any. */ + if (discr_decl == NULL || discr_lists[i] == NULL) + /* In the case we have discriminant information at all, this is + probably the default variant: as the standard says, don't + output any discriminant value/list attribute. */ + ; + else if (discr_lists[i]->dw_discr_next == NULL + && !discr_lists[i]->dw_discr_range) + /* If there is only one accepted value, don't bother outputting a + list. */ + add_discr_value (variant_die, &discr_lists[i]->dw_discr_lower_bound); + else + add_discr_list (variant_die, discr_lists[i]); + + for (tree member = TYPE_FIELDS (variant_type); + member != NULL_TREE; + member = DECL_CHAIN (member)) + { + struct vlr_context vlr_sub_ctx = { + vlr_ctx->struct_type, /* struct_type */ + NULL /* variant_part_offset */ + }; + if (is_variant_part (member)) + { + /* All offsets for fields inside variant parts are relative to + the top-level embedding RECORD_TYPE's base address. On the + other hand, offsets in GCC's types are relative to the + nested-most variant part. So we have to sum offsets each time + we recurse. */ + + vlr_sub_ctx.variant_part_offset + = fold (build2 (PLUS_EXPR, TREE_TYPE (variant_part_offset), + variant_part_offset, byte_position (member))); + gen_variant_part (member, &vlr_sub_ctx, variant_die); + } + else + { + vlr_sub_ctx.variant_part_offset = variant_part_offset; + gen_decl_die (member, NULL, &vlr_sub_ctx, variant_die); + } + } + } + + free (discr_lists); +} + /* Generate a DIE for a class member. */ static void @@ -20394,12 +22019,15 @@ gen_member_die (tree type, dw_die_ref context_die) for (i = 0; BINFO_BASE_ITERATE (binfo, i, base); i++) gen_inheritance_die (base, (accesses ? (*accesses)[i] : access_public_node), + type, context_die); } /* Now output info about the data members and type members. */ for (member = TYPE_FIELDS (type); member; member = DECL_CHAIN (member)) { + struct vlr_context vlr_ctx = { type, NULL_TREE }; + /* If we thought we were generating minimal debug info for TYPE and then changed our minds, some of the member declarations may have already been defined. Don't define them again, but @@ -20408,8 +22036,21 @@ gen_member_die (tree type, dw_die_ref context_die) child = lookup_decl_die (member); if (child) splice_child_die (context_die, child); + + /* Do not generate standard DWARF for variant parts if we are generating + the corresponding GNAT encodings: DIEs generated for both would + conflict in our mappings. */ + else if (is_variant_part (member) + && gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) + { + vlr_ctx.variant_part_offset = byte_position (member); + gen_variant_part (member, &vlr_ctx, context_die); + } else - gen_decl_die (member, NULL, context_die); + { + vlr_ctx.variant_part_offset = NULL_TREE; + gen_decl_die (member, NULL, &vlr_ctx, context_die); + } } /* We do not keep type methods in type variants. */ @@ -20430,7 +22071,7 @@ gen_member_die (tree type, dw_die_ref context_die) if (child) splice_child_die (context_die, child); else - gen_decl_die (member, NULL, context_die); + gen_decl_die (member, NULL, NULL, context_die); } } @@ -20766,7 +22407,7 @@ gen_type_die_with_usage (tree type, dw_die_ref context_die, TREE_ASM_WRITTEN (type) = 1; - gen_decl_die (TYPE_NAME (type), NULL, context_die); + gen_decl_die (TYPE_NAME (type), NULL, NULL, context_die); return; } @@ -20779,8 +22420,8 @@ gen_type_die_with_usage (tree type, dw_die_ref context_die, if (DECL_CONTEXT (TYPE_NAME (type)) && TREE_CODE (DECL_CONTEXT (TYPE_NAME (type))) == NAMESPACE_DECL) context_die = get_context_die (DECL_CONTEXT (TYPE_NAME (type))); - - gen_decl_die (TYPE_NAME (type), NULL, context_die); + + gen_decl_die (TYPE_NAME (type), NULL, NULL, context_die); return; } @@ -21053,7 +22694,7 @@ process_scope_var (tree stmt, tree decl, tree origin, dw_die_ref context_die) stmt, context_die); } else - gen_decl_die (decl, origin, context_die); + gen_decl_die (decl, origin, NULL, context_die); } /* Generate all of the decls declared within a given scope and (recursively) @@ -21219,7 +22860,7 @@ force_decl_die (tree decl) gen_decl_die() call. */ saved_external_flag = DECL_EXTERNAL (decl); DECL_EXTERNAL (decl) = 1; - gen_decl_die (decl, NULL, context_die); + gen_decl_die (decl, NULL, NULL, context_die); DECL_EXTERNAL (decl) = saved_external_flag; break; @@ -21332,7 +22973,7 @@ declare_in_namespace (tree thing, dw_die_ref context_die) if (is_fortran ()) return ns_context; if (DECL_P (thing)) - gen_decl_die (thing, NULL, ns_context); + gen_decl_die (thing, NULL, NULL, ns_context); else gen_type_die (thing, ns_context); } @@ -21392,10 +23033,14 @@ gen_namespace_die (tree decl, dw_die_ref context_die) /* Generate Dwarf debug information for a decl described by DECL. The return value is currently only meaningful for PARM_DECLs, - for all other decls it returns NULL. */ + for all other decls it returns NULL. + + If DECL is a FIELD_DECL, CTX is required: see the comment for VLR_CONTEXT. + It can be NULL otherwise. */ static dw_die_ref -gen_decl_die (tree decl, tree origin, dw_die_ref context_die) +gen_decl_die (tree decl, tree origin, struct vlr_context *ctx, + dw_die_ref context_die) { tree decl_or_origin = decl ? decl : origin; tree class_origin = NULL, ultimate_origin; @@ -21566,6 +23211,7 @@ gen_decl_die (tree decl, tree origin, dw_die_ref context_die) break; case FIELD_DECL: + gcc_assert (ctx != NULL && ctx->struct_type != NULL); /* Ignore the nameless fields that are used to skip bits but handle C++ anonymous unions and structs. */ if (DECL_NAME (decl) != NULL_TREE @@ -21573,7 +23219,7 @@ gen_decl_die (tree decl, tree origin, dw_die_ref context_die) || TREE_CODE (TREE_TYPE (decl)) == RECORD_TYPE) { gen_type_die (member_declared_type (decl), context_die); - gen_field_die (decl, context_die); + gen_field_die (decl, ctx, context_die); } break; @@ -21973,7 +23619,7 @@ dwarf2out_decl (tree decl) return; } - gen_decl_die (decl, NULL, context_die); + gen_decl_die (decl, NULL, NULL, context_die); #ifdef ENABLE_CHECKING dw_die_ref die = lookup_decl_die (decl); @@ -23593,6 +25239,25 @@ prune_unmark_dies (dw_die_ref die) FOR_EACH_CHILD (die, c, prune_unmark_dies (c)); } +/* Given LOC that is referenced by a DIE we're marking as used, find all + referenced DWARF procedures it references and mark them as used. */ + +static void +prune_unused_types_walk_loc_descr (dw_loc_descr_ref loc) +{ + for (; loc != NULL; loc = loc->dw_loc_next) + switch (loc->dw_loc_opc) + { + case DW_OP_call2: + case DW_OP_call4: + case DW_OP_call_ref: + prune_unused_types_mark (loc->dw_loc_oprnd1.v.val_die_ref.die, 1); + break; + default: + break; + } +} + /* Given DIE that we're marking as used, find any other dies it references as attributes and mark them as used. */ @@ -23604,19 +25269,38 @@ prune_unused_types_walk_attribs (dw_die_ref die) FOR_EACH_VEC_SAFE_ELT (die->die_attr, ix, a) { - if (a->dw_attr_val.val_class == dw_val_class_die_ref) + switch (AT_class (a)) { + /* Make sure DWARF procedures referenced by location descriptions will + get emitted. */ + case dw_val_class_loc: + prune_unused_types_walk_loc_descr (AT_loc (a)); + break; + case dw_val_class_loc_list: + for (dw_loc_list_ref list = AT_loc_list (a); + list != NULL; + list = list->dw_loc_next) + prune_unused_types_walk_loc_descr (list->expr); + break; + + case dw_val_class_die_ref: /* A reference to another DIE. Make sure that it will get emitted. If it was broken out into a comdat group, don't follow it. */ if (! AT_ref (a)->comdat_type_p || a->dw_attr == DW_AT_specification) prune_unused_types_mark (a->dw_attr_val.v.val_die_ref.die, 1); + break; + + case dw_val_class_str: + /* Set the string's refcount to 0 so that prune_unused_types_mark + accounts properly for it. */ + a->dw_attr_val.v.val_str->refcount = 0; + break; + + default: + break; } - /* Set the string's refcount to 0 so that prune_unused_types_mark - accounts properly for it. */ - if (AT_class (a) == dw_val_class_str) - a->dw_attr_val.v.val_str->refcount = 0; } } @@ -23767,7 +25451,6 @@ prune_unused_types_walk (dw_die_ref die) case DW_TAG_array_type: case DW_TAG_interface_type: case DW_TAG_friend: - case DW_TAG_variant_part: case DW_TAG_enumeration_type: case DW_TAG_subroutine_type: case DW_TAG_string_type: @@ -23775,10 +25458,16 @@ prune_unused_types_walk (dw_die_ref die) case DW_TAG_subrange_type: case DW_TAG_ptr_to_member_type: case DW_TAG_file_type: + /* Type nodes are useful only when other DIEs reference them --- don't + mark them. */ + /* FALLTHROUGH */ + + case DW_TAG_dwarf_procedure: + /* Likewise for DWARF procedures. */ + if (die->die_perennial_p) break; - /* It's a type node --- don't mark it. */ return; default: diff --git a/gcc/dwarf2out.h b/gcc/dwarf2out.h index 4fe3527..9a929f0 100644 --- a/gcc/dwarf2out.h +++ b/gcc/dwarf2out.h @@ -29,6 +29,7 @@ typedef struct dw_val_node *dw_val_ref; typedef struct dw_cfi_node *dw_cfi_ref; typedef struct dw_loc_descr_node *dw_loc_descr_ref; typedef struct dw_loc_list_struct *dw_loc_list_ref; +typedef struct dw_discr_list_node *dw_discr_list_ref; typedef wide_int *wide_int_ptr; @@ -150,7 +151,9 @@ enum dw_val_class dw_val_class_data8, dw_val_class_decl_ref, dw_val_class_vms_delta, - dw_val_class_high_pc + dw_val_class_high_pc, + dw_val_class_discr_value, + dw_val_class_discr_list }; /* Describe a floating point constant value, or a vector constant value. */ @@ -161,6 +164,25 @@ struct GTY(()) dw_vec_const { unsigned elt_size; }; +/* Describe a single value that a discriminant can match. + + Discriminants (in the "record variant part" meaning) are scalars. + dw_discr_list_ref and dw_discr_value are a mean to describe a set of + discriminant values that are matched by a particular variant. + + Discriminants can be signed or unsigned scalars, and can be discriminants + values. Both have to be consistent, though. */ + +struct GTY(()) dw_discr_value { + int pos; /* Whether the discriminant value is positive (unsigned). */ + union + { + HOST_WIDE_INT GTY ((tag ("0"))) sval; + unsigned HOST_WIDE_INT GTY ((tag ("1"))) uval; + } + GTY ((desc ("%1.pos"))) v; +}; + struct addr_table_entry; /* The dw_val_node describes an attribute's value, as it is @@ -197,6 +219,8 @@ struct GTY(()) dw_val_node { char * lbl1; char * lbl2; } GTY ((tag ("dw_val_class_vms_delta"))) val_vms_delta; + dw_discr_value GTY ((tag ("dw_val_class_discr_value"))) val_discr_value; + dw_discr_list_ref GTY ((tag ("dw_val_class_discr_list"))) val_discr_list; } GTY ((desc ("%1.val_class"))) v; }; @@ -210,11 +234,37 @@ struct GTY((chain_next ("%h.dw_loc_next"))) dw_loc_descr_node { /* Used to distinguish DW_OP_addr with a direct symbol relocation from DW_OP_addr with a dtp-relative symbol relocation. */ unsigned int dtprel : 1; + /* For DW_OP_pick operations: true iff. it targets a DWARF prodecure + argument. In this case, it needs to be relocated according to the current + frame offset. */ + unsigned int frame_offset_rel : 1; int dw_loc_addr; + /* When translating a function into a DWARF procedure, contains the frame + offset *before* evaluating this operation. It is -1 when not yet + initialized. */ + int dw_loc_frame_offset; + /* For DW_OP_call* operations: contains the number of stack slots that were + added overall when returning from the procedure (so it's negative if the + procedure removes slots). */ + int dw_loc_frame_offset_increment; dw_val_node dw_loc_oprnd1; dw_val_node dw_loc_oprnd2; }; +/* A variant (inside a record variant part) is selected when the corresponding + discriminant matches its set of values (see the comment for dw_discr_value). + The following datastructure holds such matching information. */ + +struct GTY(()) dw_discr_list_node { + dw_discr_list_ref dw_discr_next; + + dw_discr_value dw_discr_lower_bound; + dw_discr_value dw_discr_upper_bound; + /* This node represents only the value in dw_discr_lower_bound when it's + zero. It represents the range between the two fields (bounds included) + otherwise. */ + int dw_discr_range; +}; /* Interface from dwarf2out.c to dwarf2cfi.c. */ extern struct dw_loc_descr_node *build_cfa_loc diff --git a/gcc/function.h b/gcc/function.h index e92c17c..dbd64cb 100644 --- a/gcc/function.h +++ b/gcc/function.h @@ -378,6 +378,12 @@ struct GTY(()) function { /* Set when the tail call has been identified. */ unsigned int tail_call_marked : 1; + + /* If set, preserve the function body even when it's not called anywhere. + This is needed by debugging information generation when the function is + referenced by type properties (such as unit size) while it's not called in + the generated code. */ + unsigned int preserve_body : 1; }; /* Add the decl D to the local_decls list of FUN. */ diff --git a/gcc/stor-layout.c b/gcc/stor-layout.c index 938e54b..0caea59 100644 --- a/gcc/stor-layout.c +++ b/gcc/stor-layout.c @@ -297,13 +297,22 @@ finalize_size_functions (void) { unsigned int i; tree fndecl; + tree saved_body; for (i = 0; size_functions && size_functions->iterate (i, &fndecl); i++) { allocate_struct_function (fndecl, false); set_cfun (NULL); dump_function (TDI_original, fndecl); + + /* Keep the original tree for fndecl's body: the debug info may need to + know what it computes. */ + saved_body = unshare_expr (DECL_SAVED_TREE (fndecl)); gimplify_function_tree (fndecl); + DECL_SAVED_TREE (fndecl) = saved_body; + DECL_STRUCT_FUNCTION (fndecl)->preserve_body = 1; + + dump_function (TDI_generic, fndecl); cgraph_node::finalize_function (fndecl, false); } diff --git a/gcc/testsuite/gnat.dg/specs/debug1.ads b/gcc/testsuite/gnat.dg/specs/debug1.ads index de0a7b9..92e9184 100644 --- a/gcc/testsuite/gnat.dg/specs/debug1.ads +++ b/gcc/testsuite/gnat.dg/specs/debug1.ads @@ -11,4 +11,4 @@ package Debug1 is end Debug1; --- { dg-final { scan-assembler-times "DW_AT_artificial" 15 } } +-- { dg-final { scan-assembler-times "DW_AT_artificial" 17 } } -- 2.6.0 --------------080408090101090205000303 Content-Type: text/x-diff; name="0003-DWARF-add-a-language-hook-to-override-types-in-debug.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename*0="0003-DWARF-add-a-language-hook-to-override-types-in-debug.pa"; filename*1="tch" Content-length: 15742 >From 5ef0e7db6e4ad394deb8d22155ad5ef533a9c29a Mon Sep 17 00:00:00 2001 From: Pierre-Marie de Rodat Date: Wed, 30 Jul 2014 17:28:27 +0200 Subject: [PATCH 3/8] DWARF: add a language hook to override types in debugging information Many artificial types are introduced by GNAT in order to satisfy constraints in GCC's internal trees or to generate optimal code. These hide original types from sources and miss useful information in the debugging information or add noise to it and make debugging confusing. This change introduces a new language hook to give a chance to front-ends to restore the source types in the debugging information. This change also enhance the array descriptor language hook to handle array-wide bit/byte stride. Some arrays may contain dynamically-sized objects. Debuggers need for these a hint to know the size allocated for each element, hence the need for the array-wide bit/byte stride. The Ada front-end is enhanced to take advantage of both hooks when -fgnat-encodings=minimal, in order to keep compatibility with GDB. gcc/ada/ChangeLog: * gcc-interface/ada-tree.h (struct lang_type): Rename the t field as t1 and add a t2 one. (get_lang_specific): New. (GET_TYPE_LANG_SPECIFIC): Refactor to use get_lang_specific. (SET_TYPE_LANG_SPECIFIC): Likewise. (GET_TYPE_LANG_SPECIFIC2): New macro. (SET_TYPE_LANG_SPECIFIC2): New macro. (TYPE_DEBUG_TYPE): New macro. (SET_TYPE_DEBUG_TYPE): New macro. * gcc-interface/decl.c (gnat_to_gnu_entity): When -fgnat-encodings=minimal, set padding types' debug type to the padded one (i.e. strip ___PAD GNAT encodings) and set constrained record subtypes's debug type to the base type. * gcc-interface/misc.c (gnat_print_type): Print debug types. (gnat_get_debug_type): New. (gnat_get_array_descr_info): When -fgnat-encodings=minimal, set a byte stride for arrays that contain a type whose debug type has variable length. (LANG_HOOKS_GET_DEBUG_TYPE): Redefine macro to implement the debug type language hook. * gcc-interface/utils.c (maybe_pad_type): When -fgnat-encodings=minimal, set padding types' debug type to the padded one. Restore XVZ variables creation when -fgnat-encodings-minimal and use them to hold padding types' byte size. For library-level padding types, share this variable across translation units. Tag XVZ variables as artificial. gcc/ChangeLog: * langhooks.h (struct lang_hooks_for_types): Add a get_debug_type field. * langhooks-def.h (LANG_HOOKS_GET_DEBUG_TYPE): New macro. (LANG_HOOKS_FOR_TYPES_INITIALIZER): Initialize the get_debug_type field. * dwarf2out.h (struct array_descr_info): Add an array-wide stride field. * dwarf2out.c (modified_type_die): Invoke the get_debug_type language hook, process its result instead, if any. (gen_descr_array_type_die): Add array-wide stride processing. --- gcc/ada/gcc-interface/ada-tree.h | 28 ++++++++++++--------- gcc/ada/gcc-interface/decl.c | 4 +++ gcc/ada/gcc-interface/misc.c | 53 ++++++++++++++++++++++++++++++++++++++++ gcc/ada/gcc-interface/utils.c | 42 ++++++++++++++++++------------- gcc/dwarf2out.c | 21 ++++++++++++++++ gcc/dwarf2out.h | 5 ++++ gcc/langhooks-def.h | 4 ++- gcc/langhooks.h | 6 +++++ 8 files changed, 134 insertions(+), 29 deletions(-) diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h index 6864451..d7295a8 100644 --- a/gcc/ada/gcc-interface/ada-tree.h +++ b/gcc/ada/gcc-interface/ada-tree.h @@ -33,21 +33,21 @@ union GTY((desc ("0"), }; /* Ada uses the lang_decl and lang_type fields to hold a tree. */ -struct GTY(()) lang_type { tree t; }; +struct GTY(()) lang_type { tree t1; tree t2; }; struct GTY(()) lang_decl { tree t; }; -/* Macros to get and set the tree in TYPE_LANG_SPECIFIC. */ +extern struct lang_type *get_lang_specific (tree node); + +/* Macros to get and set the trees in TYPE_LANG_SPECIFIC. */ #define GET_TYPE_LANG_SPECIFIC(NODE) \ - (TYPE_LANG_SPECIFIC (NODE) ? TYPE_LANG_SPECIFIC (NODE)->t : NULL_TREE) + (TYPE_LANG_SPECIFIC (NODE) ? TYPE_LANG_SPECIFIC (NODE)->t1 : NULL_TREE) -#define SET_TYPE_LANG_SPECIFIC(NODE, X) \ -do { \ - tree tmp = (X); \ - if (!TYPE_LANG_SPECIFIC (NODE)) \ - TYPE_LANG_SPECIFIC (NODE) \ - = ggc_alloc (); \ - TYPE_LANG_SPECIFIC (NODE)->t = tmp; \ -} while (0) +#define SET_TYPE_LANG_SPECIFIC(NODE, X) (get_lang_specific (NODE)->t1 = (X)) + +#define GET_TYPE_LANG_SPECIFIC2(NODE) \ + (TYPE_LANG_SPECIFIC (NODE) ? TYPE_LANG_SPECIFIC (NODE)->t2 : NULL_TREE) + +#define SET_TYPE_LANG_SPECIFIC2(NODE, X) (get_lang_specific (NODE)->t2 = (X)) /* Macros to get and set the tree in DECL_LANG_SPECIFIC. */ #define GET_DECL_LANG_SPECIFIC(NODE) \ @@ -347,6 +347,12 @@ do { \ #define SET_TYPE_ADA_SIZE(NODE, X) \ SET_TYPE_LANG_SPECIFIC (RECORD_OR_UNION_CHECK (NODE), X) +/* For types with TYPE_CAN_HAVE_DEBUG_TYPE_P, this is the type to use in + debugging information. */ +#define TYPE_DEBUG_TYPE(NODE) \ + GET_TYPE_LANG_SPECIFIC2(NODE) +#define SET_TYPE_DEBUG_TYPE(NODE, X) \ + SET_TYPE_LANG_SPECIFIC2(NODE, X) /* Flags added to decl nodes. */ diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 1bd1cd2..193da10 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -1853,6 +1853,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_type = make_node (RECORD_TYPE); TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "PAD"); + if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) + SET_TYPE_DEBUG_TYPE (gnu_type, gnu_field_type); TYPE_PACKED (gnu_type) = 1; TYPE_SIZE (gnu_type) = TYPE_SIZE (gnu_field_type); TYPE_SIZE_UNIT (gnu_type) = TYPE_SIZE_UNIT (gnu_field_type); @@ -3291,6 +3293,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_type = make_node (RECORD_TYPE); TYPE_NAME (gnu_type) = gnu_entity_name; + if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) + SET_TYPE_DEBUG_TYPE (gnu_type, gnu_base_type); TYPE_PACKED (gnu_type) = TYPE_PACKED (gnu_base_type); process_attributes (&gnu_type, &attr_list, true, gnat_entity); diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c index a9be2b5..1174cac 100644 --- a/gcc/ada/gcc-interface/misc.c +++ b/gcc/ada/gcc-interface/misc.c @@ -528,6 +528,10 @@ gnat_print_type (FILE *file, tree node, int indent) default: break; } + + if (TYPE_DEBUG_TYPE (node) != NULL_TREE) + print_node_brief (file, "debug type", TYPE_DEBUG_TYPE (node), + indent + 4); } /* Return the name to be printed for DECL. */ @@ -569,6 +573,15 @@ gnat_descriptive_type (const_tree type) return NULL_TREE; } +/* Return the type to used for debugging information instead of TYPE, if any. + NULL_TREE if TYPE is fine. */ + +static tree +gnat_get_debug_type (const_tree type) +{ + return TYPE_DEBUG_TYPE (type); +} + /* Return true if types T1 and T2 are identical for type hashing purposes. Called only after doing all language independent checks. At present, this function is only called when both types are FUNCTION_TYPE. */ @@ -701,6 +714,33 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info) info->element_type = TREE_TYPE (last_dimen); + /* When arrays contain dynamically-sized elements, we usually wrap them in + padding types, or we create constrained types for them. Then, if such + types are stripped in the debugging information output, the debugger needs + a way to know the size that is reserved for each element. This is why we + emit a stride in such situations. */ + if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) + { + tree source_element_type = info->element_type; + + while (1) + { + if (TYPE_DEBUG_TYPE (source_element_type) != NULL_TREE) + source_element_type = TYPE_DEBUG_TYPE (source_element_type); + else if (TYPE_IS_PADDING_P (source_element_type)) + source_element_type + = TREE_TYPE (TYPE_FIELDS (source_element_type)); + else + break; + } + + if (TREE_CODE (TYPE_SIZE_UNIT (source_element_type)) != INTEGER_CST) + { + info->stride = TYPE_SIZE_UNIT (info->element_type); + info->stride_in_bits = false; + } + } + return true; } @@ -951,6 +991,17 @@ gnat_init_ts (void) MARK_TS_TYPED (EXIT_STMT); } +/* Return the lang specific structure attached to NODE. Allocate it (cleared) + if needed. */ + +struct lang_type * +get_lang_specific (tree node) +{ + if (!TYPE_LANG_SPECIFIC (node)) + TYPE_LANG_SPECIFIC (node) = ggc_cleared_alloc (); + return TYPE_LANG_SPECIFIC (node); +} + /* Definitions for our language-specific hooks. */ #undef LANG_HOOKS_NAME @@ -1003,6 +1054,8 @@ gnat_init_ts (void) #define LANG_HOOKS_GET_SUBRANGE_BOUNDS gnat_get_subrange_bounds #undef LANG_HOOKS_DESCRIPTIVE_TYPE #define LANG_HOOKS_DESCRIPTIVE_TYPE gnat_descriptive_type +#undef LANG_HOOKS_GET_DEBUG_TYPE +#define LANG_HOOKS_GET_DEBUG_TYPE gnat_get_debug_type #undef LANG_HOOKS_ATTRIBUTE_TABLE #define LANG_HOOKS_ATTRIBUTE_TABLE gnat_internal_attribute_table #undef LANG_HOOKS_BUILTIN_FUNCTION diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 94d5b16..6f826f1 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -1288,6 +1288,8 @@ maybe_pad_type (tree type, tree size, unsigned int align, type and name. */ record = make_node (RECORD_TYPE); TYPE_PADDING_P (record) = 1; + if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) + SET_TYPE_DEBUG_TYPE (record, type); if (Present (gnat_entity)) TYPE_NAME (record) = create_concat_name (gnat_entity, "PAD"); @@ -1358,10 +1360,8 @@ maybe_pad_type (tree type, tree size, unsigned int align, /* Unless debugging information isn't being written for the input type, write a record that shows what we are a subtype of and also make a - variable that indicates our size, if still variable. Don't do this if - asked to output as few encodings as possible. */ - if (gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL - && TREE_CODE (orig_size) != INTEGER_CST + variable that indicates our size, if still variable. */ + if (TREE_CODE (orig_size) != INTEGER_CST && TYPE_NAME (record) && TYPE_NAME (type) && !(TREE_CODE (TYPE_NAME (type)) == TYPE_DECL @@ -1377,6 +1377,8 @@ maybe_pad_type (tree type, tree size, unsigned int align, && TREE_CODE (size) != INTEGER_CST && (definition || global_bindings_p ())) { + /* Whether or not gnat_entity comes from source, this XVZ variable is + is a compilation artifact. */ size_unit = create_var_decl (concat_name (name, "XVZ"), NULL_TREE, sizetype, size_unit, true, global_bindings_p (), @@ -1385,19 +1387,25 @@ maybe_pad_type (tree type, tree size, unsigned int align, TYPE_SIZE_UNIT (record) = size_unit; } - tree marker = make_node (RECORD_TYPE); - tree orig_name = TYPE_IDENTIFIER (type); - - TYPE_NAME (marker) = concat_name (name, "XVS"); - finish_record_type (marker, - create_field_decl (orig_name, - build_reference_type (type), - marker, NULL_TREE, NULL_TREE, - 0, 0), - 0, true); - TYPE_SIZE_UNIT (marker) = size_unit; - - add_parallel_type (record, marker); + /* There is no need to show what we are a subtype of when outputting as + few encodings as possible: regular debugging infomation makes this + redundant. */ + if (gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL) + { + tree marker = make_node (RECORD_TYPE); + tree orig_name = TYPE_IDENTIFIER (type); + + TYPE_NAME (marker) = concat_name (name, "XVS"); + finish_record_type (marker, + create_field_decl (orig_name, + build_reference_type (type), + marker, NULL_TREE, NULL_TREE, + 0, 0), + 0, true); + TYPE_SIZE_UNIT (marker) = size_unit; + + add_parallel_type (record, marker); + } } rest_of_record_type_compilation (record); diff --git a/gcc/dwarf2out.c b/gcc/dwarf2out.c index 903e381..1ff6e8c 100644 --- a/gcc/dwarf2out.c +++ b/gcc/dwarf2out.c @@ -11087,6 +11087,14 @@ modified_type_die (tree type, int cv_quals, dw_die_ref context_die) if (code == ERROR_MARK) return NULL; + if (lang_hooks.types.get_debug_type) + { + tree debug_type = lang_hooks.types.get_debug_type (type); + + if (debug_type != NULL_TREE && debug_type != type) + return modified_type_die (debug_type, cv_quals, context_die); + } + cv_quals &= cv_qual_mask; /* Don't emit DW_TAG_restrict_type for DWARFv2, since it is a type @@ -19042,6 +19050,19 @@ gen_descr_array_type_die (tree type, struct array_descr_info *info, dw_scalar_form_constant | dw_scalar_form_exprloc | dw_scalar_form_reference, &context); + if (info->stride) + { + const enum dwarf_attribute attr + = (info->stride_in_bits) ? DW_AT_bit_stride : DW_AT_byte_stride; + const int forms + = (info->stride_in_bits) + ? dw_scalar_form_constant + : (dw_scalar_form_constant + | dw_scalar_form_exprloc + | dw_scalar_form_reference); + + add_scalar_info (array_die, attr, info->stride, forms, &context); + } } add_gnat_descriptive_type_attribute (array_die, type, context_die); diff --git a/gcc/dwarf2out.h b/gcc/dwarf2out.h index 9a929f0..6ae5e01 100644 --- a/gcc/dwarf2out.h +++ b/gcc/dwarf2out.h @@ -327,6 +327,8 @@ struct array_descr_info tree data_location; tree allocated; tree associated; + tree stride; + bool stride_in_bits; struct array_descr_dimen { /* GCC uses sizetype for array indices, so lower_bound and upper_bound @@ -335,6 +337,9 @@ struct array_descr_info tree bounds_type; tree lower_bound; tree upper_bound; + + /* Only Fortran uses more than one dimension for array types. For other + languages, the stride can be rather specified for the whole array. */ tree stride; } dimen[10]; }; diff --git a/gcc/langhooks-def.h b/gcc/langhooks-def.h index 18ac84d..1eafed6 100644 --- a/gcc/langhooks-def.h +++ b/gcc/langhooks-def.h @@ -176,6 +176,7 @@ extern tree lhd_make_node (enum tree_code); #define LANG_HOOKS_DESCRIPTIVE_TYPE NULL #define LANG_HOOKS_RECONSTRUCT_COMPLEX_TYPE reconstruct_complex_type #define LANG_HOOKS_ENUM_UNDERLYING_BASE_TYPE lhd_enum_underlying_base_type +#define LANG_HOOKS_GET_DEBUG_TYPE NULL #define LANG_HOOKS_FOR_TYPES_INITIALIZER { \ LANG_HOOKS_MAKE_TYPE, \ @@ -195,7 +196,8 @@ extern tree lhd_make_node (enum tree_code); LANG_HOOKS_GET_SUBRANGE_BOUNDS, \ LANG_HOOKS_DESCRIPTIVE_TYPE, \ LANG_HOOKS_RECONSTRUCT_COMPLEX_TYPE, \ - LANG_HOOKS_ENUM_UNDERLYING_BASE_TYPE \ + LANG_HOOKS_ENUM_UNDERLYING_BASE_TYPE, \ + LANG_HOOKS_GET_DEBUG_TYPE \ } /* Declaration hooks. */ diff --git a/gcc/langhooks.h b/gcc/langhooks.h index d8d01fa..28d24554 100644 --- a/gcc/langhooks.h +++ b/gcc/langhooks.h @@ -143,6 +143,12 @@ struct lang_hooks_for_types type_for_size. Used in dwarf2out.c to add a DW_AT_type base type reference to a DW_TAG_enumeration. */ tree (*enum_underlying_base_type) (const_tree); + + /* Return a type to used in the debug info instead of TYPE, or NULL_TREE to + keep TYPE. This is useful to keep a single "source type" when the + middle-end uses specialized types, for instance constrained discriminated + types in Ada. */ + tree (*get_debug_type) (const_tree); }; /* Language hooks related to decls and the symbol table. */ -- 2.6.0 --------------080408090101090205000303 Content-Type: text/x-diff; name="0004-DWARF-add-a-language-hook-for-fixed-point-types.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename*0="0004-DWARF-add-a-language-hook-for-fixed-point-types.patch" Content-length: 16899 >From 9c511761af1d8a532c4c5070dce80bdd8b21399d Mon Sep 17 00:00:00 2001 From: Pierre-Marie de Rodat Date: Tue, 4 Nov 2014 12:04:24 +0100 Subject: [PATCH 4/8] DWARF: add a language hook for fixed-point types Support for fixed-point types in GCC is not powerful enough for Ada fixed-point types: GNAT uses regular scalar types to implement them. This new language hook makes it possible to output the desired debugging information anyway. include/ChangeLog: * dwarf2.def (DW_TAG_GNU_rational_constant): New tag. (DW_AT_GNU_numerator, DW_AT_GNU_denominator): New attributes. gcc/ada/ChangeLog: * gcc-interface/ada-tree.def (POWER_EXPR): New binary operation. * gcc-interface/ada-tree.h (TYPE_FIXED_POINT_P): New macro. (TYPE_IS_FIXED_POINT_P): New macro. (TYPE_SCALE_FACTOR): New macro. (SET_TYPE_SCALE_FACTOR): New macro. * gcc-interface/decl.c: Include urealp.h (gnat_to_gnu_entity): Attach trees to encode scale factors to fixed-point types. * gcc-interface/misc.c (gnat_print_type): Print scale factors for fixed-point types. (gnat_get_fixed_point_type_info): New. (gnat_init_ts): Initialize data for the POWER_EXPR binary operation. (LANG_HOOKS_GET_FIXED_POINT_INFO): Redefine macro to implement the get_fixed_point_type_info language hook. gcc/ChangeLog: * langhooks.h (struct lang_hooks_for_types): Add a get_fixed_point_type_info field. * langhooks-def.h (LANG_HOOKS_GET_FIXED_POINT_TYPE_INFO): New macro. (LANG_HOOKS_FOR_TYPES_INITIALIZER): Initialize the get_fixed_point_type_info field. * dwarf2out.h (enum fixed_point_scale_factor): New. (struct fixed_point_type_info): New. * dwarf2out.c (base_type_die): In DWARFv3 or non-strict DWARF mode, get fixed-point type information using the debugging hook and describe it in DWARF, if any. --- gcc/ada/gcc-interface/ada-tree.def | 5 +++ gcc/ada/gcc-interface/ada-tree.h | 17 ++++++++ gcc/ada/gcc-interface/decl.c | 72 ++++++++++++++++++++++++++++++++- gcc/ada/gcc-interface/misc.c | 82 ++++++++++++++++++++++++++++++++++++++ gcc/dwarf2out.c | 52 ++++++++++++++++++++++++ gcc/dwarf2out.h | 29 ++++++++++++++ gcc/langhooks-def.h | 4 +- gcc/langhooks.h | 5 +++ 8 files changed, 263 insertions(+), 3 deletions(-) diff --git a/gcc/ada/gcc-interface/ada-tree.def b/gcc/ada/gcc-interface/ada-tree.def index 93967b5..8eb4688 100644 --- a/gcc/ada/gcc-interface/ada-tree.def +++ b/gcc/ada/gcc-interface/ada-tree.def @@ -47,6 +47,11 @@ DEFTREECODE (PLUS_NOMOD_EXPR, "plus_nomod_expr", tcc_binary, 2) This is used for loops and never shows up in the tree. */ DEFTREECODE (MINUS_NOMOD_EXPR, "minus_nomod_expr", tcc_binary, 2) +/* An expression that computes an exponentiation. Operand 0 is the base and + Operand 1 is the exponent. This node is never passed to GCC: it is only + used internally to describe fixed point types scale factors. */ +DEFTREECODE (POWER_EXPR, "power_expr", tcc_binary, 2) + /* Same as ADDR_EXPR, except that if the operand represents a bit field, return the address of the byte containing the bit. This is used for the Address attribute and never shows up in the tree. */ diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h index d7295a8..5b48168 100644 --- a/gcc/ada/gcc-interface/ada-tree.h +++ b/gcc/ada/gcc-interface/ada-tree.h @@ -126,6 +126,13 @@ do { \ #define TYPE_CONTAINS_TEMPLATE_P(NODE) \ TYPE_LANG_FLAG_3 (RECORD_OR_UNION_CHECK (NODE)) +/* For INTEGER_TYPE, nonzero if it implements a fixed-point type. */ +#define TYPE_FIXED_POINT_P(NODE) \ + TYPE_LANG_FLAG_3 (INTEGER_TYPE_CHECK (NODE)) + +#define TYPE_IS_FIXED_POINT_P(NODE) \ + (TREE_CODE (NODE) == INTEGER_TYPE && TYPE_FIXED_POINT_P (NODE)) + /* True if NODE is a thin pointer. */ #define TYPE_IS_THIN_POINTER_P(NODE) \ (POINTER_TYPE_P (NODE) \ @@ -354,6 +361,16 @@ do { \ #define SET_TYPE_DEBUG_TYPE(NODE, X) \ SET_TYPE_LANG_SPECIFIC2(NODE, X) +/* For an INTEGER_TYPE with TYPE_IS_FIXED_POINT_P, this is the value of the + scale factor. Modular types, index types (sizetype subtypes) and + fixed-point types are totally distinct types, so there is no problem with + sharing type lang specific's first slot. */ +#define TYPE_SCALE_FACTOR(NODE) \ + GET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE)) +#define SET_TYPE_SCALE_FACTOR(NODE, X) \ + SET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE), X) + + /* Flags added to decl nodes. */ /* Nonzero in a FUNCTION_DECL that represents a stubbed function diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 193da10..46b3e5b 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -51,6 +51,7 @@ #include "snames.h" #include "stringt.h" #include "uintp.h" +#include "urealp.h" #include "fe.h" #include "sinfo.h" #include "einfo.h" @@ -1632,13 +1633,80 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) break; case E_Signed_Integer_Type: - case E_Ordinary_Fixed_Point_Type: - case E_Decimal_Fixed_Point_Type: /* For integer types, just make a signed type the appropriate number of bits. */ gnu_type = make_signed_type (esize); goto discrete_type; + case E_Ordinary_Fixed_Point_Type: + case E_Decimal_Fixed_Point_Type: + { + /* Small_Value is the scale factor. */ + const Ureal gnat_small_value = Small_Value (gnat_entity); + tree scale_factor = NULL_TREE; + + gnu_type = make_signed_type (esize); + + /* Try to decode the scale factor and to save it for the fixed-point + types debug hook. */ + + /* There are various ways to describe the scale factor, however there + are cases where back-end internals cannot hold it. In such cases, + we output invalid scale factor for such cases (i.e. the 0/0 + rational constant) but we expect GNAT to output GNAT encodings, + then. Thus, keep this in sync with + Exp_Dbug.Is_Handled_Scale_Factor. */ + + /* When encoded as 1/2**N or 1/10**N, describe the scale factor as a + binary or decimal scale: it is easier to read for humans. */ + if (UI_Eq (Numerator (gnat_small_value), Uint_1) + && (Rbase (gnat_small_value) == 2 + || Rbase (gnat_small_value) == 10)) + { + /* Given RM restrictions on 'Small values, we assume here that + the denominator fits in an int. */ + const tree base = build_int_cst (integer_type_node, + Rbase (gnat_small_value)); + const tree exponent + = build_int_cst (integer_type_node, + UI_To_Int (Denominator (gnat_small_value))); + scale_factor + = build2 (RDIV_EXPR, integer_type_node, + integer_one_node, + build2 (POWER_EXPR, integer_type_node, + base, exponent)); + } + + /* Default to arbitrary scale factors descriptions. */ + else + { + const Uint num = Norm_Num (gnat_small_value); + const Uint den = Norm_Den (gnat_small_value); + + if (UI_Is_In_Int_Range (num) && UI_Is_In_Int_Range (den)) + { + const tree gnu_num + = build_int_cst (integer_type_node, + UI_To_Int (Norm_Num (gnat_small_value))); + const tree gnu_den + = build_int_cst (integer_type_node, + UI_To_Int (Norm_Den (gnat_small_value))); + scale_factor = build2 (RDIV_EXPR, integer_type_node, + gnu_num, gnu_den); + } + else + /* If compiler internals cannot represent arbitrary scale + factors, output an invalid scale factor so that debugger + don't try to handle them but so that we still have a type + in the output. Note that GNAT */ + scale_factor = integer_zero_node; + } + + TYPE_FIXED_POINT_P (gnu_type) = 1; + SET_TYPE_SCALE_FACTOR (gnu_type, scale_factor); + } + goto discrete_type; + case E_Modular_Integer_Type: { /* For modular types, make the unsigned type of the proper number diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c index 1174cac..46244a4 100644 --- a/gcc/ada/gcc-interface/misc.c +++ b/gcc/ada/gcc-interface/misc.c @@ -484,6 +484,9 @@ gnat_print_type (FILE *file, tree node, int indent) case INTEGER_TYPE: if (TYPE_MODULAR_P (node)) print_node_brief (file, "modulus", TYPE_MODULUS (node), indent + 4); + else if (TYPE_FIXED_POINT_P (node)) + print_node (file, "scale factor", TYPE_SCALE_FACTOR (node), + indent + 4); else if (TYPE_HAS_ACTUAL_BOUNDS_P (node)) print_node (file, "actual bounds", TYPE_ACTUAL_BOUNDS (node), indent + 4); @@ -582,6 +585,81 @@ gnat_get_debug_type (const_tree type) return TYPE_DEBUG_TYPE (type); } +/* Provide information in INFO for debugging output about the TYPE fixed-point + type. Return whether TYPE is handled. */ + +static bool +gnat_get_fixed_point_type_info (const_tree type, + struct fixed_point_type_info *info) +{ + tree scale_factor; + + /* GDB cannot handle fixed-point types yet, so rely on GNAT encodings + instead for it. */ + if (gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL + || !TYPE_IS_FIXED_POINT_P (type)) + return false; + + scale_factor = TYPE_SCALE_FACTOR (type); + + /* We expect here only a finite set of pattern. See fixed-point types + handling in gnat_to_gnu_entity. */ + + /* Put invalid values when compiler internals cannot represent the scale + factor. */ + if (scale_factor == integer_zero_node) + { + info->scale_factor_kind = fixed_point_scale_factor_arbitrary; + info->scale_factor.arbitrary.numerator = 0; + info->scale_factor.arbitrary.denominator = 0; + return true; + } + + if (TREE_CODE (scale_factor) == RDIV_EXPR) + { + const tree num = TREE_OPERAND (scale_factor, 0); + const tree den = TREE_OPERAND (scale_factor, 1); + + /* See if we have a binary or decimal scale. */ + if (TREE_CODE (den) == POWER_EXPR) + { + const tree base = TREE_OPERAND (den, 0); + const tree exponent = TREE_OPERAND (den, 1); + + /* We expect the scale factor to be 1 / 2 ** N or 1 / 10 ** N. */ + gcc_assert (num == integer_one_node + && TREE_CODE (base) == INTEGER_CST + && TREE_CODE (exponent) == INTEGER_CST); + switch (tree_to_shwi (base)) + { + case 2: + info->scale_factor_kind = fixed_point_scale_factor_binary; + info->scale_factor.binary = -tree_to_shwi (exponent); + return true; + + case 10: + info->scale_factor_kind = fixed_point_scale_factor_decimal; + info->scale_factor.decimal = -tree_to_shwi (exponent); + return true; + + default: + gcc_unreachable (); + } + } + + /* If we reach this point, we are handling an arbitrary scale factor. We + expect N / D with constant operands. */ + gcc_assert (TREE_CODE (num) == INTEGER_CST + && TREE_CODE (den) == INTEGER_CST); + info->scale_factor_kind = fixed_point_scale_factor_arbitrary; + info->scale_factor.arbitrary.numerator = tree_to_uhwi (num); + info->scale_factor.arbitrary.denominator = tree_to_shwi (den); + return true; + } + + gcc_unreachable (); +} + /* Return true if types T1 and T2 are identical for type hashing purposes. Called only after doing all language independent checks. At present, this function is only called when both types are FUNCTION_TYPE. */ @@ -985,6 +1063,7 @@ gnat_init_ts (void) MARK_TS_TYPED (NULL_EXPR); MARK_TS_TYPED (PLUS_NOMOD_EXPR); MARK_TS_TYPED (MINUS_NOMOD_EXPR); + MARK_TS_TYPED (POWER_EXPR); MARK_TS_TYPED (ATTR_ADDR_EXPR); MARK_TS_TYPED (STMT_STMT); MARK_TS_TYPED (LOOP_STMT); @@ -1056,6 +1135,9 @@ get_lang_specific (tree node) #define LANG_HOOKS_DESCRIPTIVE_TYPE gnat_descriptive_type #undef LANG_HOOKS_GET_DEBUG_TYPE #define LANG_HOOKS_GET_DEBUG_TYPE gnat_get_debug_type +#undef LANG_HOOKS_GET_FIXED_POINT_TYPE_INFO +#define LANG_HOOKS_GET_FIXED_POINT_TYPE_INFO \ + gnat_get_fixed_point_type_info #undef LANG_HOOKS_ATTRIBUTE_TABLE #define LANG_HOOKS_ATTRIBUTE_TABLE gnat_internal_attribute_table #undef LANG_HOOKS_BUILTIN_FUNCTION diff --git a/gcc/dwarf2out.c b/gcc/dwarf2out.c index 1ff6e8c..2780abb 100644 --- a/gcc/dwarf2out.c +++ b/gcc/dwarf2out.c @@ -10810,6 +10810,8 @@ base_type_die (tree type) { dw_die_ref base_type_result; enum dwarf_type encoding; + bool fpt_used = false; + struct fixed_point_type_info fpt_info; if (TREE_CODE (type) == ERROR_MARK || TREE_CODE (type) == VOID_TYPE) return 0; @@ -10836,6 +10838,19 @@ base_type_die (tree type) break; } } + if ((dwarf_version >= 3 || !dwarf_strict) + && lang_hooks.types.get_fixed_point_type_info) + { + memset (&fpt_info, 0, sizeof (fpt_info)); + if (lang_hooks.types.get_fixed_point_type_info (type, &fpt_info)) + { + fpt_used = true; + encoding = ((TYPE_UNSIGNED (type)) + ? DW_ATE_unsigned_fixed + : DW_ATE_signed_fixed); + break; + } + } if (TYPE_STRING_FLAG (type)) { if (TYPE_UNSIGNED (type)) @@ -10894,6 +10909,43 @@ base_type_die (tree type) add_AT_unsigned (base_type_result, DW_AT_byte_size, int_size_in_bytes (type)); add_AT_unsigned (base_type_result, DW_AT_encoding, encoding); + + if (fpt_used) + { + switch (fpt_info.scale_factor_kind) + { + case fixed_point_scale_factor_binary: + add_AT_int (base_type_result, DW_AT_binary_scale, + fpt_info.scale_factor.binary); + break; + + case fixed_point_scale_factor_decimal: + add_AT_int (base_type_result, DW_AT_decimal_scale, + fpt_info.scale_factor.decimal); + break; + + case fixed_point_scale_factor_arbitrary: + /* Arbitrary scale factors cannot be describe in standard DWARF, + yet. */ + if (!dwarf_strict) + { + /* Describe the scale factor as a rational constant. */ + const dw_die_ref scale_factor + = new_die (DW_TAG_constant, comp_unit_die (), type); + + add_AT_unsigned (scale_factor, DW_AT_GNU_numerator, + fpt_info.scale_factor.arbitrary.numerator); + add_AT_int (scale_factor, DW_AT_GNU_denominator, + fpt_info.scale_factor.arbitrary.denominator); + + add_AT_die_ref (base_type_result, DW_AT_small, scale_factor); + } + break; + + default: + gcc_unreachable (); + } + } add_pubtype (type, base_type_result); return base_type_result; diff --git a/gcc/dwarf2out.h b/gcc/dwarf2out.h index 6ae5e01..1d5865c 100644 --- a/gcc/dwarf2out.h +++ b/gcc/dwarf2out.h @@ -344,6 +344,35 @@ struct array_descr_info } dimen[10]; }; +enum fixed_point_scale_factor +{ + fixed_point_scale_factor_binary, + fixed_point_scale_factor_decimal, + fixed_point_scale_factor_arbitrary +}; + +struct fixed_point_type_info +{ + /* A scale factor is the value one has to multiply with physical data in + order to get the fixed point logical data. The DWARF standard enables one + to encode it in three ways. */ + enum fixed_point_scale_factor scale_factor_kind; + union + { + /* For binary scale factor, the scale factor is: 2 ** binary. */ + int binary; + /* For decimal scale factor, the scale factor is: 10 ** binary. */ + int decimal; + /* For arbitrary scale factor, the scale factor is: + numerator / denominator. */ + struct + { + unsigned HOST_WIDE_INT numerator; + HOST_WIDE_INT denominator; + } arbitrary; + } scale_factor; +}; + void dwarf2out_c_finalize (void); #endif /* GCC_DWARF2OUT_H */ diff --git a/gcc/langhooks-def.h b/gcc/langhooks-def.h index 1eafed6..2d02bf6 100644 --- a/gcc/langhooks-def.h +++ b/gcc/langhooks-def.h @@ -177,6 +177,7 @@ extern tree lhd_make_node (enum tree_code); #define LANG_HOOKS_RECONSTRUCT_COMPLEX_TYPE reconstruct_complex_type #define LANG_HOOKS_ENUM_UNDERLYING_BASE_TYPE lhd_enum_underlying_base_type #define LANG_HOOKS_GET_DEBUG_TYPE NULL +#define LANG_HOOKS_GET_FIXED_POINT_TYPE_INFO NULL #define LANG_HOOKS_FOR_TYPES_INITIALIZER { \ LANG_HOOKS_MAKE_TYPE, \ @@ -197,7 +198,8 @@ extern tree lhd_make_node (enum tree_code); LANG_HOOKS_DESCRIPTIVE_TYPE, \ LANG_HOOKS_RECONSTRUCT_COMPLEX_TYPE, \ LANG_HOOKS_ENUM_UNDERLYING_BASE_TYPE, \ - LANG_HOOKS_GET_DEBUG_TYPE \ + LANG_HOOKS_GET_DEBUG_TYPE, \ + LANG_HOOKS_GET_FIXED_POINT_TYPE_INFO \ } /* Declaration hooks. */ diff --git a/gcc/langhooks.h b/gcc/langhooks.h index 28d24554..64ba41f 100644 --- a/gcc/langhooks.h +++ b/gcc/langhooks.h @@ -149,6 +149,11 @@ struct lang_hooks_for_types middle-end uses specialized types, for instance constrained discriminated types in Ada. */ tree (*get_debug_type) (const_tree); + + /* Return TRUE if TYPE implements a fixed point type and fills in information + for the debugger about scale factor, etc. */ + bool (*get_fixed_point_type_info) (const_tree, + struct fixed_point_type_info *); }; /* Language hooks related to decls and the symbol table. */ -- 2.6.0 --------------080408090101090205000303 Content-Type: text/x-diff; name="0005-DWARF-describe-Ada-dynamic-arrays-as-proper-arrays.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename*0="0005-DWARF-describe-Ada-dynamic-arrays-as-proper-arrays.patc"; filename*1="h" Content-length: 12552 >From 7df1dd8036fa5aad98c0d93c9571768a4aa24664 Mon Sep 17 00:00:00 2001 From: derodat Date: Fri, 3 Oct 2014 09:57:06 +0000 Subject: [PATCH 5/8] DWARF: describe Ada dynamic arrays as proper arrays gcc/ada/ChangeLog: * gcc-interface/decl.c (gnat_to_gnu_entity): When -fgnat-encodings-minimal, do not add ___XUP/XUT suffixes to type names and do not generate ___XA parallel types. * gcc-interface/misc.c (gnat_get_array_descr_info): Match fat and thin pointers and generate the corresponding array type descriptions. --- gcc/ada/gcc-interface/decl.c | 42 ++++++---- gcc/ada/gcc-interface/misc.c | 183 +++++++++++++++++++++++++++++++++++++------ 2 files changed, 186 insertions(+), 39 deletions(-) diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 46b3e5b..1101ddb 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -2280,22 +2280,31 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) create_type_decl (create_concat_name (gnat_entity, "XUA"), tem, artificial_p, debug_info_p, gnat_entity); - /* Give the fat pointer type a name. If this is a packed array, tell - the debugger how to interpret the underlying bits. */ + /* If told to generate GNAT encodings for them (GDB rely on them at the + moment): give the fat pointer type a name. If this is a packed + array, tell the debugger how to interpret the underlying bits. */ if (Present (Packed_Array_Impl_Type (gnat_entity))) gnat_name = Packed_Array_Impl_Type (gnat_entity); else gnat_name = gnat_entity; - create_type_decl (create_concat_name (gnat_name, "XUP"), gnu_fat_type, - artificial_p, debug_info_p, gnat_entity); + if (gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL) + gnu_entity_name = create_concat_name (gnat_name, "XUP"); + create_type_decl (gnu_entity_name, gnu_fat_type, artificial_p, + debug_info_p, gnat_entity); /* Create the type to be designated by thin pointers: a record type for the array and its template. We used to shift the fields to have the template at a negative offset, but this was somewhat of a kludge; we now shift thin pointer values explicitly but only those which have a - TYPE_UNCONSTRAINED_ARRAY attached to the designated RECORD_TYPE. */ - tem = build_unc_object_type (gnu_template_type, tem, - create_concat_name (gnat_name, "XUT"), + TYPE_UNCONSTRAINED_ARRAY attached to the designated RECORD_TYPE. + Note that GDB can handle standard DWARF information for them, so we + don't have to name them as a GNAT encoding, except if specifically + asked to. */ + if (gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL) + gnu_entity_name = create_concat_name (gnat_name, "XUT"); + else + gnu_entity_name = get_entity_name (gnat_name); + tem = build_unc_object_type (gnu_template_type, tem, gnu_entity_name, debug_info_p); SET_TYPE_UNCONSTRAINED_ARRAY (tem, gnu_type); @@ -2528,14 +2537,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* We need special types for debugging information to point to the index types if they have variable bounds, are not integer - types or are biased. */ - if (TREE_CODE (gnu_orig_min) != INTEGER_CST - || TREE_CODE (gnu_orig_max) != INTEGER_CST - || TREE_CODE (gnu_index_type) != INTEGER_TYPE - || (TREE_TYPE (gnu_index_type) - && TREE_CODE (TREE_TYPE (gnu_index_type)) - != INTEGER_TYPE) - || TYPE_BIASED_REPRESENTATION_P (gnu_index_type)) + types, are biased or are wider than sizetype. These are GNAT + encodings, so we have to include them only when all encodings + are requested. */ + if (gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL + && (TREE_CODE (gnu_orig_min) != INTEGER_CST + || TREE_CODE (gnu_orig_max) != INTEGER_CST + || TREE_CODE (gnu_index_type) != INTEGER_TYPE + || (TREE_TYPE (gnu_index_type) + && TREE_CODE (TREE_TYPE (gnu_index_type)) + != INTEGER_TYPE) + || TYPE_BIASED_REPRESENTATION_P (gnu_index_type))) need_index_type_struct = true; } diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c index 46244a4..612bd2a 100644 --- a/gcc/ada/gcc-interface/misc.c +++ b/gcc/ada/gcc-interface/misc.c @@ -743,38 +743,130 @@ static bool gnat_get_array_descr_info (const_tree type, struct array_descr_info *info) { bool convention_fortran_p; - tree index_type; + bool is_array = false; + bool is_fat_ptr = false; - const_tree dimen = NULL_TREE; + const tree type_ = const_cast (type); + + const_tree first_dimen = NULL_TREE; const_tree last_dimen = NULL_TREE; + const_tree dimen; int i; - if (TREE_CODE (type) != ARRAY_TYPE - || !TYPE_DOMAIN (type) - || !TYPE_INDEX_TYPE (TYPE_DOMAIN (type))) + /* Temporaries created in the first pass and used in the second one for thin + pointers. The first one is an expression that yields the template record + from the base address (i.e. the PLACEHOLDER_EXPR). The second one is just + a cursor through this record's fields. */ + tree thinptr_template_expr = NULL_TREE; + tree thinptr_bound_field = NULL_TREE; + + /* First pass: gather all information about this array except everything + related to dimensions. */ + + /* Only handle ARRAY_TYPE nodes that come from GNAT. */ + if (TREE_CODE (type) == ARRAY_TYPE + && TYPE_DOMAIN (type) + && TYPE_INDEX_TYPE (TYPE_DOMAIN (type))) + { + is_array = true; + first_dimen = type; + info->data_location = NULL_TREE; + } + + else if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL + && TYPE_IS_FAT_POINTER_P (type)) + { + const tree ua_type = TYPE_UNCONSTRAINED_ARRAY (type_); + + /* This will be our base object address. */ + const tree placeholder_expr = build0 (PLACEHOLDER_EXPR, type_); + + /* We assume below that maybe_unconstrained_array returns an INDIRECT_REF + node. */ + const tree ua_val + = maybe_unconstrained_array (build_unary_op (INDIRECT_REF, + ua_type, + placeholder_expr)); + + is_fat_ptr = true; + first_dimen = TREE_TYPE (ua_val); + + /* Get the *address* of the array, not the array itself. */ + info->data_location = TREE_OPERAND (ua_val, 0); + } + + /* Unlike fat pointers (which appear for unconstrained arrays passed in + argument), thin pointers are used only for array access types, so we want + them to appear in the debug info as pointers to an array type. That's why + we match only the RECORD_TYPE here instead of the POINTER_TYPE with the + TYPE_IS_THIN_POINTER_P predicate. */ + else if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL + && TREE_CODE (type) == RECORD_TYPE + && TYPE_CONTAINS_TEMPLATE_P (type)) + { + /* This will be our base object address. Note that we assume that + pointers to these will actually point to the array field (thin + pointers are shifted). */ + const tree placeholder_expr = build0 (PLACEHOLDER_EXPR, type_); + const tree placeholder_addr + = build_unary_op (ADDR_EXPR, NULL_TREE, placeholder_expr); + + const tree bounds_field = TYPE_FIELDS (type); + const tree bounds_type = TREE_TYPE (bounds_field); + const tree array_field = DECL_CHAIN (bounds_field); + const tree array_type = TREE_TYPE (array_field); + + /* Shift the thin pointer address to get the address of the template. */ + const tree shift_amount + = fold_build1 (NEGATE_EXPR, sizetype, byte_position (array_field)); + tree template_addr + = build_binary_op (POINTER_PLUS_EXPR, TREE_TYPE (placeholder_addr), + placeholder_addr, shift_amount); + template_addr + = fold_convert (TYPE_POINTER_TO (bounds_type), template_addr); + + first_dimen = array_type; + + /* The thin pointer is already the pointer to the array data, so there's + no need for a specific "data location" expression. */ + info->data_location = NULL_TREE; + + thinptr_template_expr = build_unary_op (INDIRECT_REF, + bounds_type, + template_addr); + thinptr_bound_field = TYPE_FIELDS (bounds_type); + } + else return false; - /* Count how many dimentions this array has. */ - for (i = 0, dimen = type; ; ++i, dimen = TREE_TYPE (dimen)) - if (i > 0 - && (TREE_CODE (dimen) != ARRAY_TYPE - || !TYPE_MULTI_ARRAY_P (dimen))) - break; - info->ndimensions = i; - convention_fortran_p = TYPE_CONVENTION_FORTRAN_P (type); + /* Second pass: compute the remaining information: dimensions and + corresponding bounds. */ - /* TODO: for row major ordering, we probably want to emit nothing and + /* If this array has fortran convention, it's arranged in column-major + order, so our view here has reversed dimensions. */ + convention_fortran_p = TYPE_CONVENTION_FORTRAN_P (first_dimen); + /* ??? For row major ordering, we probably want to emit nothing and instead specify it as the default in Dw_TAG_compile_unit. */ info->ordering = (convention_fortran_p ? array_descr_ordering_column_major : array_descr_ordering_row_major); - info->base_decl = NULL_TREE; - info->data_location = NULL_TREE; - info->allocated = NULL_TREE; - info->associated = NULL_TREE; + /* Count how many dimensions this array has. */ + for (i = 0, dimen = first_dimen; ; ++i, dimen = TREE_TYPE (dimen)) + { + if (i > 0 + && (TREE_CODE (dimen) != ARRAY_TYPE + || !TYPE_MULTI_ARRAY_P (dimen))) + break; + last_dimen = dimen; + } + info->ndimensions = i; + info->element_type = TREE_TYPE (last_dimen); + + /* Now iterate over all dimensions in source-order and fill the info + structure. */ for (i = (convention_fortran_p ? info->ndimensions - 1 : 0), - dimen = type; + dimen = first_dimen; 0 <= i && i < info->ndimensions; @@ -782,15 +874,58 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info) dimen = TREE_TYPE (dimen)) { /* We are interested in the stored bounds for the debug info. */ - index_type = TYPE_INDEX_TYPE (TYPE_DOMAIN (dimen)); + tree index_type = TYPE_INDEX_TYPE (TYPE_DOMAIN (dimen)); + if (is_array || is_fat_ptr) + { + /* GDB does not handle very well the self-referencial bound + expressions we are able to generate here for XUA types (they are + used only by XUP encodings) so avoid them in this case. Note that + there are two cases where we generate self-referencial bound + expressions: arrays that are constrained by record discriminants + and XUA types. */ + const bool is_xua_type = + (TREE_CODE (TYPE_CONTEXT (first_dimen)) != RECORD_TYPE + && contains_placeholder_p (TYPE_MIN_VALUE (index_type))); + + if (is_xua_type && gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL) + { + info->dimen[i].lower_bound = NULL_TREE; + info->dimen[i].upper_bound = NULL_TREE; + } + else + { + info->dimen[i].lower_bound = TYPE_MIN_VALUE (index_type); + info->dimen[i].upper_bound = TYPE_MAX_VALUE (index_type); + } + } + + /* This is a thin pointer. */ + else + { + info->dimen[i].lower_bound + = build_component_ref (thinptr_template_expr, NULL_TREE, + thinptr_bound_field, false); + thinptr_bound_field = DECL_CHAIN (thinptr_bound_field); + + info->dimen[i].upper_bound + = build_component_ref (thinptr_template_expr, NULL_TREE, + thinptr_bound_field, false); + thinptr_bound_field = DECL_CHAIN (thinptr_bound_field); + } + + /* The DWARF back-end will output exactly INDEX_TYPE as the array index' + "root" type, so pell subtypes when possible. */ + while (TREE_TYPE (index_type) != NULL_TREE + && !subrange_type_for_debug_p (index_type, NULL, NULL)) + index_type = TREE_TYPE (index_type); info->dimen[i].bounds_type = index_type; - info->dimen[i].lower_bound = TYPE_MIN_VALUE (index_type); - info->dimen[i].upper_bound = TYPE_MAX_VALUE (index_type); - last_dimen = dimen; + info->dimen[i].stride = NULL_TREE; } - info->element_type = TREE_TYPE (last_dimen); + /* These are Fortran-specific fields. They make no sense here. */ + info->allocated = NULL_TREE; + info->associated = NULL_TREE; /* When arrays contain dynamically-sized elements, we usually wrap them in padding types, or we create constrained types for them. Then, if such -- 2.6.0 --------------080408090101090205000303 Content-Type: text/x-diff; name="0006-DWARF-create-a-macro-for-max-dimensions-for-array-de.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename*0="0006-DWARF-create-a-macro-for-max-dimensions-for-array-de.pa"; filename*1="tch" Content-length: 3814 >From 49de7b666262df4f4bdf86622485c1d7663e6f38 Mon Sep 17 00:00:00 2001 From: Pierre-Marie de Rodat Date: Fri, 21 Nov 2014 22:20:02 +0100 Subject: [PATCH 6/8] DWARF: create a macro for max dimensions for array descr. lang. hook The array descriptor language hook can hold the description of a limited number of array dimensions. This macro will ease preventing overflow in front-ends. gcc/ada/ChangeLog: * gcc-interface/misc.c (gnat_get_array_descr_info): When the array has more dimensions than the language hook can handle, fall back to a nested arrays description. Handle context-less array types. gcc/ChangeLog: * dwarf2out.h (DWARF2OUT_ARRAY_DESCR_INFO_MAX_DIMEN): New macro. (struct array_descr_info): Use it for the dimensions array's size. * dwarf2out.c (gen_type_die_with_usage): Check that the array descr. language hook does not return an array with more dimensions that it should. --- gcc/ada/gcc-interface/misc.c | 16 +++++++++++++++- gcc/dwarf2out.c | 4 ++++ gcc/dwarf2out.h | 4 +++- 3 files changed, 22 insertions(+), 2 deletions(-) diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c index 612bd2a..11a5ea4 100644 --- a/gcc/ada/gcc-interface/misc.c +++ b/gcc/ada/gcc-interface/misc.c @@ -860,7 +860,20 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info) break; last_dimen = dimen; } + info->ndimensions = i; + + /* Too many dimensions? Give up generating proper description: yield instead + nested arrays. Note that in this case, this hook is invoked once on each + intermediate array type: be consistent and output nested arrays for all + dimensions. */ + if (info->ndimensions > DWARF2OUT_ARRAY_DESCR_INFO_MAX_DIMEN + || TYPE_MULTI_ARRAY_P (first_dimen)) + { + info->ndimensions = 1; + last_dimen = first_dimen; + } + info->element_type = TREE_TYPE (last_dimen); /* Now iterate over all dimensions in source-order and fill the info @@ -885,7 +898,8 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info) expressions: arrays that are constrained by record discriminants and XUA types. */ const bool is_xua_type = - (TREE_CODE (TYPE_CONTEXT (first_dimen)) != RECORD_TYPE + (TYPE_CONTEXT (first_dimen) != NULL_TREE + && TREE_CODE (TYPE_CONTEXT (first_dimen)) != RECORD_TYPE && contains_placeholder_p (TYPE_MIN_VALUE (index_type))); if (is_xua_type && gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL) diff --git a/gcc/dwarf2out.c b/gcc/dwarf2out.c index 2780abb..ee06bf7 100644 --- a/gcc/dwarf2out.c +++ b/gcc/dwarf2out.c @@ -22513,6 +22513,10 @@ gen_type_die_with_usage (tree type, dw_die_ref context_die, memset (&info, 0, sizeof (info)); if (lang_hooks.types.get_array_descr_info (type, &info)) { + /* Fortran sometimes emits array types with no dimension. */ + gcc_assert (info.ndimensions >= 0 + && (info.ndimensions + <= DWARF2OUT_ARRAY_DESCR_INFO_MAX_DIMEN)); gen_descr_array_type_die (type, &info, context_die); TREE_ASM_WRITTEN (type) = 1; return; diff --git a/gcc/dwarf2out.h b/gcc/dwarf2out.h index 1d5865c..4efd2d8 100644 --- a/gcc/dwarf2out.h +++ b/gcc/dwarf2out.h @@ -318,6 +318,8 @@ enum array_descr_ordering array_descr_ordering_column_major }; +#define DWARF2OUT_ARRAY_DESCR_INFO_MAX_DIMEN 16 + struct array_descr_info { int ndimensions; @@ -341,7 +343,7 @@ struct array_descr_info /* Only Fortran uses more than one dimension for array types. For other languages, the stride can be rather specified for the whole array. */ tree stride; - } dimen[10]; + } dimen[DWARF2OUT_ARRAY_DESCR_INFO_MAX_DIMEN]; }; enum fixed_point_scale_factor -- 2.6.0 --------------080408090101090205000303 Content-Type: text/x-diff; name="0007-DWARF-add-a-language-hook-for-scalar-biased-types.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename*0="0007-DWARF-add-a-language-hook-for-scalar-biased-types.patch" Content-length: 7339 >From 74e7619587cb45a04b362806ae4bb9d55ed25e07 Mon Sep 17 00:00:00 2001 From: Pierre-Marie de Rodat Date: Thu, 8 Jan 2015 11:07:06 +0100 Subject: [PATCH 7/8] DWARF: add a language hook for scalar biased types Front-ends like GNAT for Ada sometimes use biased encodings for integral types. This change creates a new language hook so that the bias information can make it into the debugging information back-end and introduces an experimental DWARF attribute to hold it. include/ChangeLog: * dwarf2.def (DW_AT_GNU_bias): New attribute. gcc/ada/ChangeLog: * gcc-interface/misc.c (gnat_get_type_bias): New. (LANG_HOOKS_GET_TYPE_BIAS): Redefine macro to implement the get_type_bias language hook. gcc/ChangeLog: * langhooks.h (struct lang_hooks_for_types): New get_bias_field. * langhooks-def.h (LANG_HOOKS_GET_TYPE_BIAS): New. (LANG_HOOKS_FOR_TYPES_INITIALIZER): Initialize the get_bias_field. * dwarf2out.c (base_type_die): In non-strict DWARF mode, invoke the get_type_bias language hook for INTEGER_TYPE nodes. If it returns a bias, emit an attribute for it. (subrange_type_die): Change signature to handle bias. If non-strict DWARF mode, emit an attribute for it, if one passed. (modified_type_die): For subrange types, invoke the get_type_bias langage hook and pass the bias to subrange_type_die. --- gcc/ada/gcc-interface/misc.c | 12 ++++++++++++ gcc/dwarf2out.c | 27 ++++++++++++++++++++++++--- gcc/langhooks-def.h | 2 ++ gcc/langhooks.h | 5 +++++ 4 files changed, 43 insertions(+), 3 deletions(-) diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c index 11a5ea4..e329a28 100644 --- a/gcc/ada/gcc-interface/misc.c +++ b/gcc/ada/gcc-interface/misc.c @@ -981,6 +981,16 @@ gnat_get_subrange_bounds (const_tree gnu_type, tree *lowval, tree *highval) *highval = TYPE_MAX_VALUE (gnu_type); } +static tree +gnat_get_type_bias (const_tree gnu_type) +{ + if (TREE_CODE (gnu_type) == INTEGER_TYPE + && TYPE_BIASED_REPRESENTATION_P (gnu_type) + && gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) + return TYPE_RM_MIN_VALUE(gnu_type); + return NULL_TREE; +} + /* GNU_TYPE is the type of a subprogram parameter. Determine if it should be passed by reference by default. */ @@ -1280,6 +1290,8 @@ get_lang_specific (tree node) #define LANG_HOOKS_GET_ARRAY_DESCR_INFO gnat_get_array_descr_info #undef LANG_HOOKS_GET_SUBRANGE_BOUNDS #define LANG_HOOKS_GET_SUBRANGE_BOUNDS gnat_get_subrange_bounds +#undef LANG_HOOKS_GET_TYPE_BIAS +#define LANG_HOOKS_GET_TYPE_BIAS gnat_get_type_bias #undef LANG_HOOKS_DESCRIPTIVE_TYPE #define LANG_HOOKS_DESCRIPTIVE_TYPE gnat_descriptive_type #undef LANG_HOOKS_GET_DEBUG_TYPE diff --git a/gcc/dwarf2out.c b/gcc/dwarf2out.c index ee06bf7..55484e2 100644 --- a/gcc/dwarf2out.c +++ b/gcc/dwarf2out.c @@ -3286,7 +3286,7 @@ static void output_line_info (bool); static void output_file_names (void); static dw_die_ref base_type_die (tree); static int is_base_type (tree); -static dw_die_ref subrange_type_die (tree, tree, tree, dw_die_ref); +static dw_die_ref subrange_type_die (tree, tree, tree, tree, dw_die_ref); static int decl_quals (const_tree); static dw_die_ref modified_type_die (tree, int, dw_die_ref); static dw_die_ref generic_parameter_die (tree, tree, bool, dw_die_ref); @@ -10812,6 +10812,7 @@ base_type_die (tree type) enum dwarf_type encoding; bool fpt_used = false; struct fixed_point_type_info fpt_info; + tree type_bias = NULL_TREE; if (TREE_CODE (type) == ERROR_MARK || TREE_CODE (type) == VOID_TYPE) return 0; @@ -10862,6 +10863,10 @@ base_type_die (tree type) encoding = DW_ATE_unsigned; else encoding = DW_ATE_signed; + + if (!dwarf_strict + && lang_hooks.types.get_type_bias) + type_bias = lang_hooks.types.get_type_bias (type); break; case REAL_TYPE: @@ -10946,6 +10951,12 @@ base_type_die (tree type) gcc_unreachable (); } } + if (type_bias != NULL) + add_scalar_info (base_type_result, DW_AT_GNU_bias, type_bias, + dw_scalar_form_constant + | dw_scalar_form_exprloc + | dw_scalar_form_reference, + NULL); add_pubtype (type, base_type_result); return base_type_result; @@ -11047,7 +11058,8 @@ offset_int_type_size_in_bits (const_tree type) to a DIE that describes the given type. */ static dw_die_ref -subrange_type_die (tree type, tree low, tree high, dw_die_ref context_die) +subrange_type_die (tree type, tree low, tree high, tree bias, + dw_die_ref context_die) { dw_die_ref subrange_die; const HOST_WIDE_INT size_in_bytes = int_size_in_bytes (type); @@ -11068,6 +11080,12 @@ subrange_type_die (tree type, tree low, tree high, dw_die_ref context_die) add_bound_info (subrange_die, DW_AT_lower_bound, low, NULL); if (high) add_bound_info (subrange_die, DW_AT_upper_bound, high, NULL); + if (bias && !dwarf_strict) + add_scalar_info (subrange_die, DW_AT_GNU_bias, bias, + dw_scalar_form_constant + | dw_scalar_form_exprloc + | dw_scalar_form_reference, + NULL); return subrange_die; } @@ -11272,7 +11290,10 @@ modified_type_die (tree type, int cv_quals, dw_die_ref context_die) && TREE_TYPE (type) != NULL_TREE && subrange_type_for_debug_p (type, &low, &high)) { - mod_type_die = subrange_type_die (type, low, high, context_die); + tree bias = NULL_TREE; + if (lang_hooks.types.get_type_bias) + bias = lang_hooks.types.get_type_bias (type); + mod_type_die = subrange_type_die (type, low, high, bias, context_die); item_type = TREE_TYPE (type); } else if (is_base_type (type)) diff --git a/gcc/langhooks-def.h b/gcc/langhooks-def.h index 2d02bf6..db96e91 100644 --- a/gcc/langhooks-def.h +++ b/gcc/langhooks-def.h @@ -173,6 +173,7 @@ extern tree lhd_make_node (enum tree_code); #define LANG_HOOKS_TYPE_HASH_EQ NULL #define LANG_HOOKS_GET_ARRAY_DESCR_INFO NULL #define LANG_HOOKS_GET_SUBRANGE_BOUNDS NULL +#define LANG_HOOKS_GET_TYPE_BIAS NULL #define LANG_HOOKS_DESCRIPTIVE_TYPE NULL #define LANG_HOOKS_RECONSTRUCT_COMPLEX_TYPE reconstruct_complex_type #define LANG_HOOKS_ENUM_UNDERLYING_BASE_TYPE lhd_enum_underlying_base_type @@ -195,6 +196,7 @@ extern tree lhd_make_node (enum tree_code); LANG_HOOKS_TYPE_HASH_EQ, \ LANG_HOOKS_GET_ARRAY_DESCR_INFO, \ LANG_HOOKS_GET_SUBRANGE_BOUNDS, \ + LANG_HOOKS_GET_TYPE_BIAS, \ LANG_HOOKS_DESCRIPTIVE_TYPE, \ LANG_HOOKS_RECONSTRUCT_COMPLEX_TYPE, \ LANG_HOOKS_ENUM_UNDERLYING_BASE_TYPE, \ diff --git a/gcc/langhooks.h b/gcc/langhooks.h index 64ba41f..9dda629 100644 --- a/gcc/langhooks.h +++ b/gcc/langhooks.h @@ -127,6 +127,11 @@ struct lang_hooks_for_types /* Fill in information for the debugger about the bounds of TYPE. */ void (*get_subrange_bounds) (const_tree, tree *, tree *); + /* Called on INTEGER_TYPEs. Return NULL_TREE for non-biased types. For + biased types, return as an INTEGER_CST node the value that is represented + by a physical zero. */ + tree (*get_type_bias) (const_tree); + /* A type descriptive of TYPE's complex layout generated to help the debugger to decode variable-length or self-referential constructs. This is only used for the AT_GNAT_descriptive_type DWARF attribute. */ -- 2.6.0 --------------080408090101090205000303 Content-Type: text/x-diff; name="0008-DWARF-describe-properly-Ada-packed-arrays.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="0008-DWARF-describe-properly-Ada-packed-arrays.patch" Content-length: 20759 >From ba3bccbe40571753befb83a6b64e10a968242639 Mon Sep 17 00:00:00 2001 From: derodat Date: Thu, 18 Dec 2014 12:45:52 +0000 Subject: [PATCH 8/8] DWARF: describe properly Ada packed arrays gcc/ada/ChangeLog: * gcc-interface/ada-tree.h (TYPE_IMPLEMENTS_PACKED_ARRAY_P, TYPE_CAN_HAVE_DEBUG_TYPE_P, TYPE_ORIGINAL_PACKED_ARRAY, SET_TYPE_ORIGINAL_PACKED_ARRAY): New macros. * gcc-interface/decl.c (add_parallel_type_for_packed_array): Rename to associate_original_type_to_packed_array. When -fgnat-encodings=minimal, set original packed array type as so instead of as a parallel type to the implementation type. In this case, also rename the implementation type to the name of the original array type. (gnat_to_gnu_entity): Update invocations to add_parallel_type_for_packed_array. Tag ARRAY_TYPE nodes for packed arrays with the TYPE_PACKED flag. When -fgnat-encodings=minimal: - strip ___XP suffixes in packed arrays' names; - set the debug type for padding records around packed arrays to the packed array; - do not attach ___XUP types as parallel types of constrained array types. * gcc-interface/misc.c (gnat_print_type): Update to handle orignal packed arrays. (gnat_get_debug_type): Update to reject packed arrays implementation types. (get_array_bit_stride): New. (gnat_get_array_descr_info): Add packed arrays handling. * gcc-interface/utils.c (maybe_pad_type): When -fgnat-encodings=minimal, set the name of the padding type to the one of the original packed type, if any. Fix TYPE_DECL peeling around the name of the input type. --- gcc/ada/gcc-interface/ada-tree.h | 26 ++++++++ gcc/ada/gcc-interface/decl.c | 80 +++++++++++++++++++----- gcc/ada/gcc-interface/misc.c | 131 ++++++++++++++++++++++++++++++++++----- gcc/ada/gcc-interface/utils.c | 12 +++- 4 files changed, 220 insertions(+), 29 deletions(-) diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h index 5b48168..3eb7dd2 100644 --- a/gcc/ada/gcc-interface/ada-tree.h +++ b/gcc/ada/gcc-interface/ada-tree.h @@ -183,6 +183,17 @@ do { \ /* True if TYPE can alias any other types. */ #define TYPE_UNIVERSAL_ALIASING_P(NODE) TYPE_LANG_FLAG_6 (NODE) +/* True for types that implement a packed array and for original packed array + types. */ +#define TYPE_IMPLEMENTS_PACKED_ARRAY_P(NODE) \ + ((TREE_CODE (NODE) == ARRAY_TYPE && TYPE_PACKED (NODE)) \ + || (TREE_CODE (NODE) == INTEGER_TYPE && TYPE_PACKED_ARRAY_TYPE_P (NODE))) \ + +/* True for types that can hold a debug type. */ +#define TYPE_CAN_HAVE_DEBUG_TYPE_P(NODE) \ + (!TYPE_IMPLEMENTS_PACKED_ARRAY_P (NODE) \ + && TYPE_DEBUG_TYPE (NODE) != NULL_TREE) + /* For an UNCONSTRAINED_ARRAY_TYPE, this is the record containing both the template and the object. @@ -370,6 +381,21 @@ do { \ #define SET_TYPE_SCALE_FACTOR(NODE, X) \ SET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE), X) +/* For types with TYPE_CAN_HAVE_DEBUG_TYPE_P, this is the type to use in + debugging information. */ +#define TYPE_DEBUG_TYPE(NODE) \ + GET_TYPE_LANG_SPECIFIC2(NODE) +#define SET_TYPE_DEBUG_TYPE(NODE, X) \ + SET_TYPE_LANG_SPECIFIC2(NODE, X) + +/* For types with TYPE_IMPLEMENTS_PACKED_ARRAY_P, this is the original packed + array type. Note that this predicate is trou for original packed array + types, so these cannot have a debug type. */ +#define TYPE_ORIGINAL_PACKED_ARRAY(NODE) \ + GET_TYPE_LANG_SPECIFIC2(NODE) +#define SET_TYPE_ORIGINAL_PACKED_ARRAY(NODE, X) \ + SET_TYPE_LANG_SPECIFIC2(NODE, X) + /* Flags added to decl nodes. */ diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 1101ddb..f2af4d5 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -202,7 +202,7 @@ static tree get_rep_part (tree); static tree create_variant_part_from (tree, vec , tree, tree, vec ); static void copy_and_substitute_in_size (tree, tree, vec ); -static void add_parallel_type_for_packed_array (tree, Entity_Id); +static void associate_original_type_to_packed_array (tree, Entity_Id); static const char *get_entity_char (Entity_Id); /* The relevant constituents of a subprogram binding to a GCC builtin. Used @@ -1819,9 +1819,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) TYPE_STUB_DECL (gnu_type) = create_type_stub_decl (gnu_entity_name, gnu_type); - /* For a packed array, make the original array type a parallel type. */ + /* For a packed array, make the original array type a parallel/debug + type. */ if (debug_info_p && Is_Packed_Array_Impl_Type (gnat_entity)) - add_parallel_type_for_packed_array (gnu_type, gnat_entity); + associate_original_type_to_packed_array (gnu_type, gnat_entity); discrete_type: @@ -1854,6 +1855,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) UI_To_gnu (RM_Size (gnat_entity), bitsizetype)); TYPE_PACKED_ARRAY_TYPE_P (gnu_type) = 1; + /* Strip the ___XP suffix for standard DWARF. */ + if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) + gnu_entity_name = TYPE_NAME (gnu_type); + /* Create a stripped-down declaration, mainly for debugging. */ create_type_decl (gnu_entity_name, gnu_type, true, debug_info_p, gnat_entity); @@ -1892,8 +1897,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (debug_info_p) { - /* Make the original array type a parallel type. */ - add_parallel_type_for_packed_array (gnu_type, gnat_entity); + /* Make the original array type a parallel/debug type. */ + associate_original_type_to_packed_array (gnu_type, gnat_entity); + + /* Since GNU_TYPE is a padding type around the packed array + implementation type, the padded type is its debug type. */ + if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) + SET_TYPE_DEBUG_TYPE (gnu_type, gnu_field_type); rest_of_record_type_compilation (gnu_type); } @@ -2247,6 +2257,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) TYPE_CONVENTION_FORTRAN_P (tem) = convention_fortran_p; + /* Tag top-level ARRAY_TYPE nodes for packed arrays and their + implementation types as such so that the debug information back-end + can output the appropriate description for them. */ + TYPE_PACKED (tem) + = (Is_Packed (gnat_entity) + || Is_Packed_Array_Impl_Type (gnat_entity)); + if (Treat_As_Volatile (gnat_entity)) tem = change_qualified_type (tem, TYPE_QUAL_VOLATILE); @@ -2606,6 +2623,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) TYPE_NONALIASED_COMPONENT (gnu_type) = 1; } + /* Strip the ___XP suffix for standard DWARF. */ + if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL + && Is_Packed_Array_Impl_Type (gnat_entity)) + { + Entity_Id gnat_original_array_type + = Underlying_Type (Original_Array_Type (gnat_entity)); + + gnu_entity_name + = get_entity_name (gnat_original_array_type); + } + /* Attach the TYPE_STUB_DECL in case we have a parallel type. */ TYPE_STUB_DECL (gnu_type) = create_type_stub_decl (gnu_entity_name, gnu_type); @@ -2680,17 +2708,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) } /* If this is a packed array type, make the original array type a - parallel type. Otherwise, do it for the base array type if it - isn't artificial to make sure it is kept in the debug info. */ + parallel/debug type. Otherwise, if such GNAT encodings are + required, do it for the base array type if it isn't artificial to + make sure it is kept in the debug info. */ if (debug_info_p) { if (Is_Packed_Array_Impl_Type (gnat_entity)) - add_parallel_type_for_packed_array (gnu_type, gnat_entity); + associate_original_type_to_packed_array (gnu_type, + gnat_entity); else { tree gnu_base_decl = gnat_to_gnu_entity (Etype (gnat_entity), NULL_TREE, 0); - if (!DECL_ARTIFICIAL (gnu_base_decl)) + if (gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL + && !DECL_ARTIFICIAL (gnu_base_decl)) add_parallel_type (gnu_type, TREE_TYPE (TREE_TYPE (gnu_base_decl))); } @@ -2701,6 +2732,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) = (Is_Packed_Array_Impl_Type (gnat_entity) && Is_Bit_Packed_Array (Original_Array_Type (gnat_entity))); + /* Tag top-level ARRAY_TYPE nodes for packed arrays and their + implementation types as such so that the debug information back-end + can output the appropriate description for them. */ + TYPE_PACKED (gnu_type) + = (Is_Packed (gnat_entity) + || Is_Packed_Array_Impl_Type (gnat_entity)); + /* If the size is self-referential and the maximum size doesn't overflow, use it. */ if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)) @@ -2757,6 +2795,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) NULL_TREE, 0); this_made_decl = true; gnu_type = TREE_TYPE (gnu_decl); + save_gnu_tree (gnat_entity, NULL_TREE, false); gnu_inner = gnu_type; @@ -8724,12 +8763,14 @@ copy_and_substitute_in_size (tree new_type, tree old_type, TYPE_SIZE_UNIT (new_type) = variable_size (TYPE_SIZE_UNIT (new_type)); } -/* Add a parallel type to GNU_TYPE, the translation of GNAT_ENTITY, which is - the implementation type of a packed array type (Is_Packed_Array_Impl_Type). - The parallel type is the original array type if it has been translated. */ +/* Associate to GNU_TYPE, the translation of GNAT_ENTITY, which is + the implementation type of a packed array type (Is_Packed_Array_Impl_Type), + the original array type if it has been translated. This association is a + parallel type for GNAT encodings or a debug type for standard DWARF. Note + that for standard DWARF, we also want to get the original type name. */ static void -add_parallel_type_for_packed_array (tree gnu_type, Entity_Id gnat_entity) +associate_original_type_to_packed_array (tree gnu_type, Entity_Id gnat_entity) { Entity_Id gnat_original_array_type = Underlying_Type (Original_Array_Type (gnat_entity)); @@ -8743,7 +8784,18 @@ add_parallel_type_for_packed_array (tree gnu_type, Entity_Id gnat_entity) if (TYPE_IS_DUMMY_P (gnu_original_array_type)) return; - add_parallel_type (gnu_type, gnu_original_array_type); + if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) + { + tree original_name = TYPE_NAME (gnu_original_array_type); + + if (TREE_CODE (original_name) == TYPE_DECL) + original_name = DECL_NAME (original_name); + + SET_TYPE_ORIGINAL_PACKED_ARRAY (gnu_type, gnu_original_array_type); + TYPE_NAME (gnu_type) = original_name; + } + else + add_parallel_type (gnu_type, gnu_original_array_type); } /* Given a type T, a FIELD_DECL F, and a replacement value R, return a diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c index e329a28..fbd0c1c 100644 --- a/gcc/ada/gcc-interface/misc.c +++ b/gcc/ada/gcc-interface/misc.c @@ -532,9 +532,12 @@ gnat_print_type (FILE *file, tree node, int indent) break; } - if (TYPE_DEBUG_TYPE (node) != NULL_TREE) - print_node_brief (file, "debug type", TYPE_DEBUG_TYPE (node), - indent + 4); + if (TYPE_CAN_HAVE_DEBUG_TYPE_P (node) && TYPE_DEBUG_TYPE (node) != NULL_TREE) + print_node_brief (file, "debug type", TYPE_DEBUG_TYPE (node), indent + 4); + else if (TYPE_IMPLEMENTS_PACKED_ARRAY_P (node) + && TYPE_ORIGINAL_PACKED_ARRAY (node) != NULL_TREE) + print_node_brief (file, "original packed array", + TYPE_ORIGINAL_PACKED_ARRAY (node), indent + 4); } /* Return the name to be printed for DECL. */ @@ -582,7 +585,18 @@ gnat_descriptive_type (const_tree type) static tree gnat_get_debug_type (const_tree type) { - return TYPE_DEBUG_TYPE (type); + if (TYPE_CAN_HAVE_DEBUG_TYPE_P (type)) + { + type = TYPE_DEBUG_TYPE (type); + /* ??? Kludge: the get_debug_type language hook is processed after the + array descriptor language hook, so if there is an array behind this + type, the latter is supposed to handle it. Still, we can get here + with a type we are not supposed to handle (when the DWARF back-end + processes the type of a variable), so keep this guard. */ + if (type != NULL_TREE && !TYPE_IMPLEMENTS_PACKED_ARRAY_P (type)) + return const_cast (type); + } + return NULL_TREE; } /* Provide information in INFO for debugging output about the TYPE fixed-point @@ -736,17 +750,21 @@ gnat_type_max_size (const_tree gnu_type) return max_unitsize; } +static tree get_array_bit_stride (tree comp_type); + /* Provide information in INFO for debug output about the TYPE array type. Return whether TYPE is handled. */ static bool -gnat_get_array_descr_info (const_tree type, struct array_descr_info *info) +gnat_get_array_descr_info (const_tree const_type, + struct array_descr_info *info) { bool convention_fortran_p; bool is_array = false; bool is_fat_ptr = false; + bool is_packed_array = false; - const tree type_ = const_cast (type); + tree type = const_cast (const_type); const_tree first_dimen = NULL_TREE; const_tree last_dimen = NULL_TREE; @@ -760,6 +778,20 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info) tree thinptr_template_expr = NULL_TREE; tree thinptr_bound_field = NULL_TREE; + /* ??? Kludge: see gnat_get_debug_type. */ + if (TYPE_CAN_HAVE_DEBUG_TYPE_P (type) + && TYPE_DEBUG_TYPE (type) != NULL_TREE) + type = TYPE_DEBUG_TYPE (type); + + /* If we have an implementation type for a packed array, get the orignial + array type. */ + if (TYPE_IMPLEMENTS_PACKED_ARRAY_P (type) + && TYPE_ORIGINAL_PACKED_ARRAY (type) != NULL_TREE) + { + is_packed_array = true; + type = TYPE_ORIGINAL_PACKED_ARRAY (type); + } + /* First pass: gather all information about this array except everything related to dimensions. */ @@ -776,10 +808,10 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info) else if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL && TYPE_IS_FAT_POINTER_P (type)) { - const tree ua_type = TYPE_UNCONSTRAINED_ARRAY (type_); + const tree ua_type = TYPE_UNCONSTRAINED_ARRAY (type); /* This will be our base object address. */ - const tree placeholder_expr = build0 (PLACEHOLDER_EXPR, type_); + const tree placeholder_expr = build0 (PLACEHOLDER_EXPR, type); /* We assume below that maybe_unconstrained_array returns an INDIRECT_REF node. */ @@ -807,7 +839,7 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info) /* This will be our base object address. Note that we assume that pointers to these will actually point to the array field (thin pointers are shifted). */ - const tree placeholder_expr = build0 (PLACEHOLDER_EXPR, type_); + const tree placeholder_expr = build0 (PLACEHOLDER_EXPR, type); const tree placeholder_addr = build_unary_op (ADDR_EXPR, NULL_TREE, placeholder_expr); @@ -842,6 +874,8 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info) /* Second pass: compute the remaining information: dimensions and corresponding bounds. */ + if (TYPE_PACKED (first_dimen)) + is_packed_array = true; /* If this array has fortran convention, it's arranged in column-major order, so our view here has reversed dimensions. */ convention_fortran_p = TYPE_CONVENTION_FORTRAN_P (first_dimen); @@ -941,13 +975,13 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info) info->allocated = NULL_TREE; info->associated = NULL_TREE; - /* When arrays contain dynamically-sized elements, we usually wrap them in - padding types, or we create constrained types for them. Then, if such - types are stripped in the debugging information output, the debugger needs - a way to know the size that is reserved for each element. This is why we - emit a stride in such situations. */ if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) { + /* When arrays contain dynamically-sized elements, we usually wrap them + in padding types, or we create constrained types for them. Then, if + such types are stripped in the debugging information output, the + debugger needs a way to know the size that is reserved for each + element. This is why we emit a stride in such situations. */ tree source_element_type = info->element_type; while (1) @@ -966,11 +1000,80 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info) info->stride = TYPE_SIZE_UNIT (info->element_type); info->stride_in_bits = false; } + + /* We need to specify a bit stride when it does not correspond to the + natural size of the contained elements. ??? Note that we do not + support packed records and nested packed arrays. */ + else if (is_packed_array) + { + info->stride = get_array_bit_stride (info->element_type); + info->stride_in_bits = true; + } } return true; } +/* Given the component type COMP_TYPE of a packed array, return an expression + that computes the bit stride of this packed array. Return NULL_TREE when + unsuccessful. */ + +static tree +get_array_bit_stride (tree comp_type) +{ + struct array_descr_info info; + tree stride; + + /* Simple case: the array contains an integral type: return its RM size. */ + if (INTEGRAL_TYPE_P (comp_type)) + return TYPE_RM_SIZE (comp_type); + + /* Otherwise, see if this is an array we can analyze. */ + memset (&info, 0, sizeof (info)); + if (!gnat_get_array_descr_info (comp_type, &info) + || info.stride == NULL_TREE) + /* If it's not, give it up. */ + return NULL_TREE; + + /* Otherwise, the array stride is the inner array's stride multiplied by the + number of elements it contains. Note that if the inner array is not + packed, then the stride is "natural" and thus does not deserve an + attribute. */ + stride = info.stride; + if (!info.stride_in_bits) + { + stride = fold_convert (bitsizetype, stride); + stride = build_binary_op (MULT_EXPR, bitsizetype, + stride, build_int_cstu (bitsizetype, 8)); + } + + for (int i = 0; i < info.ndimensions; ++i) + { + tree count; + + if (info.dimen[i].lower_bound == NULL_TREE + || info.dimen[i].upper_bound == NULL_TREE) + return NULL_TREE; + + /* Put in count an expression that computes the length of this + dimension. */ + count = build_binary_op (MINUS_EXPR, sbitsizetype, + fold_convert (sbitsizetype, + info.dimen[i].upper_bound), + fold_convert (sbitsizetype, + info.dimen[i].lower_bound)), + count = build_binary_op (PLUS_EXPR, sbitsizetype, + count, build_int_cstu (sbitsizetype, 1)); + count = build_binary_op (MAX_EXPR, sbitsizetype, + count, + build_int_cstu (sbitsizetype, 0)); + count = fold_convert (bitsizetype, count); + stride = build_binary_op (MULT_EXPR, bitsizetype, stride, count); + } + + return stride; +} + /* GNU_TYPE is a subtype of an integral type. Set LOWVAL to the low bound and HIGHVAL to the high bound, respectively. */ diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 6f826f1..c3d4bc0 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -1291,7 +1291,17 @@ maybe_pad_type (tree type, tree size, unsigned int align, if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) SET_TYPE_DEBUG_TYPE (record, type); - if (Present (gnat_entity)) + /* ??? Kludge: padding types around packed array implementation types will be + considered as root types in the array descriptor language hook (see + gnat_get_array_descr_info). Give them the original packed array type + name so that the one coming from sources appears in the debugging + information. */ + if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL + && TYPE_IMPLEMENTS_PACKED_ARRAY_P (type) + && TYPE_ORIGINAL_PACKED_ARRAY (type) != NULL_TREE) + TYPE_NAME (record) + = TYPE_NAME (TYPE_ORIGINAL_PACKED_ARRAY (type)); + else if (Present (gnat_entity)) TYPE_NAME (record) = create_concat_name (gnat_entity, "PAD"); TYPE_ALIGN (record) = align ? align : orig_align; -- 2.6.0 --------------080408090101090205000303--