[gcc r12-1173] Fix signedness issue in DWARF functions (1)

[gcc r12-1173] Fix signedness issue in DWARF functions (1)

[Eric Botcazou]

https://gcc.gnu.org/g:e26b748a62e5bc59f6671faab75f737503c87319

commit r12-1173-ge26b748a62e5bc59f6671faab75f737503c87319
Author: Eric Botcazou <ebotcazou@adacore.com>
Date:   Fri May 28 19:18:37 2021 +0200

    Fix signedness issue in DWARF functions (1)
    
    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...  */
    
    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 an optimization to avoid emitting useless comparisons.
    
    gcc/
            * 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.

Diff:
---
 gcc/dwarf2out.c | 203 ++++++++++++++++++++++++++++++++++----------------------
 1 file changed, 124 insertions(+), 79 deletions(-)

diff --git a/gcc/dwarf2out.c b/gcc/dwarf2out.c
index b99598eb9f8..fbda47ec977 100644
--- a/gcc/dwarf2out.c
+++ b/gcc/dwarf2out.c
@@ -15176,7 +15176,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,
@@ -17994,6 +17994,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
@@ -18062,7 +18064,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)
@@ -18204,6 +18206,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:
@@ -18335,9 +18343,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:
@@ -18346,9 +18351,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.  */
@@ -18397,8 +18399,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.
@@ -18407,8 +18409,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;
@@ -18453,11 +18462,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);
@@ -18586,47 +18590,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:
@@ -19286,7 +19291,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;
 
@@ -19366,23 +19378,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);
 
@@ -19473,25 +19512,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.  */
@@ -19668,12 +19704,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);
 
@@ -22308,8 +22346,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;
 
@@ -25292,13 +25336,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.  */
@@ -25329,11 +25366,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),