Hi,
the compiler can synthesize DWARF functions to describe the location and size
of components in discriminated record types with variant part in Ada, but a
limitation is that most quantities must have DWARF2_ADDR_SIZE or else be the
result of a zero-extension to DWARF2_ADDR_SIZE of a smaller quantity, as
documented in loc_list_from_tree_1:
/* ??? 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... */
Now in Ada discriminants may be either signed or unsigned, so this limitation
is problematic. Therefore the attached patch adds a strict_signedness field
to the loc_descr_context that is passed around in parts of the DWARF back-end
and changes loc_list_from_tree_1 to act upon it being set to true. It also
contains a small optimization to avoid emitting useless comparisons with 0.
Tested on x86-64/Linux, both GCC and GDB, OK for the mainline?
2021-04-26 Eric Botcazou <ebotca...@adacore.com>
* dwarf2out.c (scompare_loc_descriptor): Fix head comment.
(is_handled_procedure_type): Likewise.
(struct loc_descr_context): Add strict_signedness field.
(resolve_args_picking_1): Deal with DW_OP_[GNU_]deref_type,
DW_OP_[GNU_]convert and DW_OP_[GNU_]reinterpret.
(resolve_args_picking): Minor tweak.
(function_to_dwarf_procedure): Initialize strict_signedness field.
(type_byte_size): Likewise.
(field_byte_offset): Likewise.
(gen_descr_array_type_die): Likewise.
(gen_variant_part): Likewise.
(loc_list_from_tree_1) <CALL_EXPR>: Tidy up and set strict_signedness
to true when a context is present before evaluating the arguments.
<COND_EXPR>: Do not generate a useless comparison with zero.
When dereferencing an address, if strict_signedness is true and the
type is small and signed, use DW_OP_deref_type to do the dereference
and then DW_OP_convert to convert back to the generic type.
--
Eric Botcazoudiff --git a/gcc/dwarf2out.c b/gcc/dwarf2out.c
index c36fd5a7f6a..73543190c2d 100644
--- a/gcc/dwarf2out.c
+++ b/gcc/dwarf2out.c
@@ -15086,7 +15086,7 @@ scompare_loc_descriptor_narrow (enum dwarf_location_atom op, rtx rtl,
return compare_loc_descriptor (op, op0, op1);
}
-/* Return location descriptor for unsigned comparison OP RTL. */
+/* Return location descriptor for signed comparison OP RTL. */
static dw_loc_descr_ref
scompare_loc_descriptor (enum dwarf_location_atom op, rtx rtl,
@@ -17904,6 +17904,8 @@ struct loc_descr_context
bool placeholder_arg;
/* True if PLACEHOLDER_EXPR has been seen. */
bool placeholder_seen;
+ /* True if strict preservation of signedness has been requested. */
+ bool strict_signedness;
};
/* DWARF procedures generation
@@ -17972,7 +17974,7 @@ new_dwarf_proc_die (dw_loc_descr_ref location, tree fndecl,
/* 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. */
+ aren't wider than the DWARF expression evaluation stack). */
static bool
is_handled_procedure_type (tree type)
@@ -18114,6 +18116,12 @@ resolve_args_picking_1 (dw_loc_descr_ref loc, unsigned initial_frame_offset,
case DW_OP_bit_piece:
case DW_OP_implicit_value:
case DW_OP_stack_value:
+ case DW_OP_deref_type:
+ case DW_OP_convert:
+ case DW_OP_reinterpret:
+ case DW_OP_GNU_deref_type:
+ case DW_OP_GNU_convert:
+ case DW_OP_GNU_reinterpret:
break;
case DW_OP_addr:
@@ -18245,9 +18253,6 @@ resolve_args_picking_1 (dw_loc_descr_ref loc, unsigned initial_frame_offset,
case DW_OP_entry_value:
case DW_OP_const_type:
case DW_OP_regval_type:
- case DW_OP_deref_type:
- case DW_OP_convert:
- case DW_OP_reinterpret:
case DW_OP_form_tls_address:
case DW_OP_GNU_push_tls_address:
case DW_OP_GNU_uninit:
@@ -18256,9 +18261,6 @@ resolve_args_picking_1 (dw_loc_descr_ref loc, unsigned initial_frame_offset,
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. */
@@ -18307,8 +18309,8 @@ resolve_args_picking (dw_loc_descr_ref loc, unsigned initial_frame_offset,
this operation. */
hash_map<dw_loc_descr_ref, unsigned> frame_offsets;
- return resolve_args_picking_1 (loc, initial_frame_offset, dpi,
- frame_offsets);
+ return
+ resolve_args_picking_1 (loc, initial_frame_offset, dpi, frame_offsets);
}
/* Try to generate a DWARF procedure that computes the same result as FNDECL.
@@ -18317,8 +18319,15 @@ resolve_args_picking (dw_loc_descr_ref loc, unsigned initial_frame_offset,
static dw_die_ref
function_to_dwarf_procedure (tree fndecl)
{
- struct loc_descr_context ctx;
struct dwarf_procedure_info dpi;
+ struct loc_descr_context ctx = {
+ NULL_TREE, /* context_type */
+ NULL_TREE, /* base_decl */
+ &dpi, /* dpi */
+ false, /* placeholder_arg */
+ false, /* placeholder_seen */
+ true /* strict_signedness */
+ };
dw_die_ref dwarf_proc_die;
tree tree_body = DECL_SAVED_TREE (fndecl);
dw_loc_descr_ref loc_body, epilogue;
@@ -18363,11 +18372,6 @@ function_to_dwarf_procedure (tree fndecl)
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;
- ctx.placeholder_arg = false;
- ctx.placeholder_seen = false;
dpi.fndecl = fndecl;
dpi.args_count = list_length (DECL_ARGUMENTS (fndecl));
loc_body = loc_descriptor_from_tree (tree_body, 0, &ctx);
@@ -18496,47 +18500,48 @@ loc_list_from_tree_1 (tree loc, int want_address,
case CALL_EXPR:
{
- 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)
+ if (callee
+ && is_handled_procedure_type (TREE_TYPE (TREE_TYPE (callee)))
+ && (dwarf_proc = function_to_dwarf_procedure (callee)))
{
- dw_loc_descr_ref loc_descr
- = loc_descriptor_from_tree (CALL_EXPR_ARG (loc, i), 0,
- context);
+ /* DWARF procedures are used for size functions, which are built
+ when size expressions contain conditional constructs, so we
+ request strict preservation of signedness for comparisons. */
+ bool old_strict_signedness;
+ if (context)
+ {
+ old_strict_signedness = context->strict_signedness;
+ context->strict_signedness = true;
+ }
- if (loc_descr == 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 (int i = call_expr_nargs (loc) - 1; i >= 0; --i)
+ {
+ tree arg = CALL_EXPR_ARG (loc, i);
+ ret1 = loc_descriptor_from_tree (arg, 0, context);
+ if (!ret1)
+ {
+ expansion_failed (arg, NULL_RTX, "CALL_EXPR argument");
+ return NULL;
+ }
+ add_loc_descr (&ret, ret1);
+ }
- 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;
+ add_loc_descr (&ret, ret1);
+ if (context)
+ context->strict_signedness = old_strict_signedness;
}
-
- 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;
- add_loc_descr (&ret, ret1);
+ else
+ expansion_failed (loc, NULL_RTX, "CALL_EXPR target");
break;
-
- call_expansion_failed:
- expansion_failed (loc, NULL_RTX, "CALL_EXPR");
- /* There are no opcodes for these operations. */
- return 0;
}
case PREINCREMENT_EXPR:
@@ -19184,7 +19189,14 @@ loc_list_from_tree_1 (tree loc, int want_address,
= 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_1 (TREE_OPERAND (loc, 0), 0, context);
+ /* DW_OP_bra is branch-on-nonzero so avoid doing useless work. */
+ if (TREE_CODE (TREE_OPERAND (loc, 0)) == NE_EXPR
+ && integer_zerop (TREE_OPERAND (TREE_OPERAND (loc, 0), 1)))
+ list_ret
+ = loc_list_from_tree_1 (TREE_OPERAND (TREE_OPERAND (loc, 0), 0),
+ 0, context);
+ else
+ list_ret = loc_list_from_tree_1 (TREE_OPERAND (loc, 0), 0, context);
if (list_ret == 0 || lhs == 0 || rhs == 0)
return 0;
@@ -19264,23 +19276,50 @@ loc_list_from_tree_1 (tree loc, int want_address,
if (!want_address && have_address)
{
HOST_WIDE_INT size = int_size_in_bytes (TREE_TYPE (loc));
+ enum machine_mode mode = TYPE_MODE (TREE_TYPE (loc));
+ scalar_int_mode int_mode;
+ dw_die_ref type_die;
+ dw_loc_descr_ref deref;
+ /* If the size is greater than DWARF2_ADDR_SIZE, bail out. */
if (size > DWARF2_ADDR_SIZE || size == -1)
{
expansion_failed (loc, NULL_RTX,
"DWARF address size mismatch");
return 0;
}
+
+ /* If it is equal to DWARF2_ADDR_SIZE, extension does not matter. */
else if (size == DWARF2_ADDR_SIZE)
- op = DW_OP_deref;
+ deref = new_loc_descr (DW_OP_deref, size, 0);
+
+ /* If it is lower than DWARF2_ADDR_SIZE, DW_OP_deref_size will zero-
+ extend the value, which is really OK for unsigned types only. */
+ else if (!(context && context->strict_signedness)
+ || TYPE_UNSIGNED (TREE_TYPE (loc))
+ || (dwarf_strict && dwarf_version < 5)
+ || !is_a <scalar_int_mode> (mode, &int_mode)
+ || !(type_die = base_type_for_mode (mode, false)))
+ deref = new_loc_descr (DW_OP_deref_size, size, 0);
+
+ /* Use DW_OP_deref_type for signed integral types if possible, but
+ convert back to the generic type to avoid type mismatches later. */
else
- op = DW_OP_deref_size;
+ {
+ deref = new_loc_descr (dwarf_OP (DW_OP_deref_type), size, 0);
+ deref->dw_loc_oprnd2.val_class = dw_val_class_die_ref;
+ deref->dw_loc_oprnd2.v.val_die_ref.die = type_die;
+ deref->dw_loc_oprnd2.v.val_die_ref.external = 0;
+ add_loc_descr (&deref,
+ new_loc_descr (dwarf_OP (DW_OP_convert), 0, 0));
+ }
if (ret)
- add_loc_descr (&ret, new_loc_descr (op, size, 0));
+ add_loc_descr (&ret, deref);
else
- add_loc_descr_to_each (list_ret, new_loc_descr (op, size, 0));
+ add_loc_descr_to_each (list_ret, deref);
}
+
if (ret)
list_ret = new_loc_list (ret, NULL, 0, NULL, 0, NULL);
@@ -19371,25 +19410,22 @@ round_up_to_align (const offset_int &t, unsigned int align)
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<tree> (type);
- ctx.base_decl = NULL_TREE;
- ctx.dpi = NULL;
- ctx.placeholder_arg = false;
- ctx.placeholder_seen = false;
+ struct loc_descr_context ctx = {
+ const_cast<tree> (type), /* context_type */
+ NULL_TREE, /* base_decl */
+ NULL, /* dpi */
+ false, /* placeholder_arg */
+ false, /* placeholder_seen */
+ false /* strict_signedness */
+ };
- 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);
+ tree tree_size = TYPE_SIZE_UNIT (TYPE_MAIN_VARIANT (type));
+ return tree_size ? loc_descriptor_from_tree (tree_size, 0, &ctx) : NULL;
}
/* Helper structure for RECORD_TYPE processing. */
@@ -19566,12 +19602,14 @@ field_byte_offset (const_tree decl, struct vlr_context *ctx,
*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 */
false, /* placeholder_arg */
- false /* placeholder_seen */
+ false, /* placeholder_seen */
+ false /* strict_signedness */
};
loc_result = loc_list_from_tree (tree_result, 0, &loc_ctx);
@@ -22198,8 +22236,14 @@ 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);
- struct loc_descr_context context = { type, info->base_decl, NULL,
- false, false };
+ struct loc_descr_context context = {
+ type, /* context_type */
+ info->base_decl, /* base_decl */
+ NULL, /* dpi */
+ false, /* placeholder_arg */
+ false, /* placeholder_seen */
+ false /* strict_signedness */
+ };
enum dwarf_tag subrange_tag = DW_TAG_subrange_type;
int dim;
@@ -25182,13 +25226,6 @@ gen_variant_part (tree variant_part_decl, struct vlr_context *vlr_ctx,
{
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 */
- false, /* placeholder_arg */
- false /* placeholder_seen */
- };
/* The FIELD_DECL node in STRUCT_TYPE that acts as the discriminant, or
NULL_TREE if there is no such field. */
@@ -25219,11 +25256,19 @@ gen_variant_part (tree variant_part_decl, struct vlr_context *vlr_ctx,
}
/* 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. */
+ 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))
{
+ struct loc_descr_context ctx = {
+ vlr_ctx->struct_type, /* context_type */
+ NULL_TREE, /* base_decl */
+ NULL, /* dpi */
+ false, /* placeholder_arg */
+ false, /* placeholder_seen */
+ false /* strict_signedness */
+ };
const tree dwarf_proc_fndecl
= build_decl (UNKNOWN_LOCATION, FUNCTION_DECL, NULL_TREE,
build_function_type (TREE_TYPE (variant_part_offset),
