public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [PATCHES] Enhance standard DWARF for Ada
@ 2015-07-16  8:36 Pierre-Marie de Rodat
  2015-07-16  8:42 ` [PATCH 1/8] Add a flag to control the balance between GNAT encodings, and std. DWARF Pierre-Marie de Rodat
                   ` (8 more replies)
  0 siblings, 9 replies; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-07-16  8:36 UTC (permalink / raw)
  To: GCC Patches

Hello,

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.

As most debuggers (including GDB) do not support these DWARF 
descriptions yet, it is necessary to still make it possible to generate 
the old GNAT encodings, though. Hence the first change, which introduces 
an option (-fgnat-encodings=all|gdb|minimal) that selects how much GNAT 
encodings must be emitted:

   - -fgnat-encodings=all emits as much encodings as before (i.e. before 
these series of patches);

   - -fgnat-encodings=gdb (the default) emits all the standard DWARF 
that the current GDB can handle (so this will vary with time) and emit 
GNAT encodings for the rest;

   - -fgnat-encodings=minimal emits as much standard DWARF as possible 
in the compiler and still emit GNAT encodings for the rest (this will 
vary with time as well).

At the moment, there is no difference between -fgnat-encodings=all|gdb 
but I hope this will change soon thanks to ongoing work on GDB (for 
instance: 
<https://sourceware.org/git/gitweb.cgi?p=binutils-gdb.git;a=commit;h=df25ebbd091aebc132f97ffd6ce9cf7964a57981>).

The remaining commits enhance the DWARF back-end (mostly dwarf2out.c), 
the Ada front-end (mostly gcc/ada/gcc-interface/*) and sometimes adapts 
the Fortran front-end as well in order to emit this new DWARF. In order 
to do so, it sometimes introduces new language hooks to pass information 
that aren't available in trees.

The result has been bootstrapped and regtested successfully on 
x86_64-linux. Besides, this triggers no regression by default 
(-fgnat-encodings=gdb). Note however that being unable to test 
-fgnat-encodings=minimal under with debugger right now, I also have 
written a small Python testsuite using pyelftools[1] in order to check 
for a few examples that the expected DIEs/attributes are properly 
generated (that was useful during development but is very ad-hoc, so I 
haven't published it yet).

Ok for trunk? Thank you in advance for the review!

[1] https://github.com/eliben/pyelftools/

-- 
Pierre-Marie de Rodat

^ permalink raw reply	[flat|nested] 53+ messages in thread

* [PATCH 1/8] Add a flag to control the balance between GNAT encodings, and std. DWARF
  2015-07-16  8:36 [PATCHES] Enhance standard DWARF for Ada Pierre-Marie de Rodat
@ 2015-07-16  8:42 ` Pierre-Marie de Rodat
  2015-07-16  9:18   ` Andreas Schwab
  2015-07-16  8:43 ` [PATCH 2/8] DWARF: handle variable-length records and variant parts Pierre-Marie de Rodat
                   ` (7 subsequent siblings)
  8 siblings, 1 reply; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-07-16  8:42 UTC (permalink / raw)
  To: GCC Patches

[-- Attachment #1: Type: text/plain, Size: 702 bytes --]

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.

-- 
Pierre-Marie de Rodat

[-- Attachment #2: 0001-Add-a-flag-to-control-the-balance-between-GNAT-encod.patch --]
[-- Type: text/x-diff, Size: 4843 bytes --]

From 77212283fa0ddbbf6aef4a6f16aa0e8286b811f3 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
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 5b2d8b3..2b7bd1b 100644
--- a/gcc/ada/gcc-interface/misc.c
+++ b/gcc/ada/gcc-interface/misc.c
@@ -236,12 +236,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;
@@ -268,6 +269,7 @@ gnat_post_options (const char **pfilename ATTRIBUTE_UNUSED)
   if (!global_options_set.x_flag_diagnostics_show_caret)
     global_dc->show_caret = false;
 
+  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 6b2ccbc..d921b4b 100644
--- a/gcc/common.opt
+++ b/gcc/common.opt
@@ -161,6 +161,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
@@ -1318,6 +1323,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 9d38ba1..d0b0080 100644
--- a/gcc/defaults.h
+++ b/gcc/defaults.h
@@ -1436,4 +1436,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 2f820a5..2e6eb41 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 visibility settings.  This is deliberately ordered from most
    to least visibility.  */
 #ifndef SYMBOL_VISIBILITY_DEFINED
-- 
2.4.5


^ permalink raw reply	[flat|nested] 53+ messages in thread

* [PATCH 2/8] DWARF: handle variable-length records and variant parts
  2015-07-16  8:36 [PATCHES] Enhance standard DWARF for Ada Pierre-Marie de Rodat
  2015-07-16  8:42 ` [PATCH 1/8] Add a flag to control the balance between GNAT encodings, and std. DWARF Pierre-Marie de Rodat
@ 2015-07-16  8:43 ` Pierre-Marie de Rodat
  2015-07-16  9:00   ` Pierre-Marie de Rodat
  2015-07-16  8:44 ` [PATCH 3/8] DWARF: add a language hook to override types in debugging information Pierre-Marie de Rodat
                   ` (6 subsequent siblings)
  8 siblings, 1 reply; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-07-16  8:43 UTC (permalink / raw)
  To: GCC Patches

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.

-- 
Pierre-Marie de Rodat

^ permalink raw reply	[flat|nested] 53+ messages in thread

* [PATCH 3/8] DWARF: add a language hook to override types in debugging information
  2015-07-16  8:36 [PATCHES] Enhance standard DWARF for Ada Pierre-Marie de Rodat
  2015-07-16  8:42 ` [PATCH 1/8] Add a flag to control the balance between GNAT encodings, and std. DWARF Pierre-Marie de Rodat
  2015-07-16  8:43 ` [PATCH 2/8] DWARF: handle variable-length records and variant parts Pierre-Marie de Rodat
@ 2015-07-16  8:44 ` Pierre-Marie de Rodat
  2015-07-16  8:45 ` [PATCH 4/8] DWARF: add a language hook for fixed-point types Pierre-Marie de Rodat
                   ` (5 subsequent siblings)
  8 siblings, 0 replies; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-07-16  8:44 UTC (permalink / raw)
  To: GCC Patches

[-- Attachment #1: Type: text/plain, Size: 2910 bytes --]

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.

-- 
Pierre-Marie de Rodat

[-- Attachment #2: 0003-DWARF-add-a-language-hook-to-override-types-in-debug.patch --]
[-- Type: text/x-diff, Size: 15740 bytes --]

From d50a4b3d02753ccd89e05d08d9f7a9516afdf8de Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
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 5f6d0a1..2fc960e 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<struct lang_type> (); \
-  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 bb2edcb..ab4f62b 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 2b7bd1b..2c68240 100644
--- a/gcc/ada/gcc-interface/misc.c
+++ b/gcc/ada/gcc-interface/misc.c
@@ -516,6 +516,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.  */
@@ -557,6 +561,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.  */
@@ -689,6 +702,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;
 }
 
@@ -939,6 +979,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<struct lang_type> ();
+  return TYPE_LANG_SPECIFIC (node);
+}
+
 /* Definitions for our language-specific hooks.  */
 
 #undef  LANG_HOOKS_NAME
@@ -991,6 +1042,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 b3be982..7676993 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 a32521c..a3837cf 100644
--- a/gcc/dwarf2out.c
+++ b/gcc/dwarf2out.c
@@ -11030,6 +11030,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
@@ -18984,6 +18992,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 0bd6be9..fafa610 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.4.5


^ permalink raw reply	[flat|nested] 53+ messages in thread

* [PATCH 4/8] DWARF: add a language hook for fixed-point types
  2015-07-16  8:36 [PATCHES] Enhance standard DWARF for Ada Pierre-Marie de Rodat
                   ` (2 preceding siblings ...)
  2015-07-16  8:44 ` [PATCH 3/8] DWARF: add a language hook to override types in debugging information Pierre-Marie de Rodat
@ 2015-07-16  8:45 ` Pierre-Marie de Rodat
  2015-08-18  8:32   ` Pierre-Marie de Rodat
  2015-07-16  8:46 ` [PATCH 5/8] DWARF: describe Ada dynamic arrays as proper arrays Pierre-Marie de Rodat
                   ` (4 subsequent siblings)
  8 siblings, 1 reply; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-07-16  8:45 UTC (permalink / raw)
  To: GCC Patches

[-- Attachment #1: Type: text/plain, Size: 1822 bytes --]

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.

-- 
Pierre-Marie de Rodat

[-- Attachment #2: 0004-DWARF-add-a-language-hook-for-fixed-point-types.patch --]
[-- Type: text/x-diff, Size: 18015 bytes --]

From 6f02aaf4d6a3fa6543de33c57809d7a810da7c36 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
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                    | 53 ++++++++++++++++++++++++
 gcc/dwarf2out.h                    | 29 ++++++++++++++
 gcc/langhooks-def.h                |  4 +-
 gcc/langhooks.h                    |  5 +++
 include/dwarf2.def                 |  5 +++
 9 files changed, 269 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 2fc960e..8c4fdc9 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 ab4f62b..b629a7f 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 2c68240..d146051 100644
--- a/gcc/ada/gcc-interface/misc.c
+++ b/gcc/ada/gcc-interface/misc.c
@@ -472,6 +472,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);
@@ -570,6 +573,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.  */
@@ -973,6 +1051,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);
@@ -1044,6 +1123,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 a3837cf..2653c67 100644
--- a/gcc/dwarf2out.c
+++ b/gcc/dwarf2out.c
@@ -10753,6 +10753,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;
@@ -10779,6 +10781,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))
@@ -10837,6 +10852,44 @@ 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_GNU_rational_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 fafa610..655d91a 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.  */
diff --git a/include/dwarf2.def b/include/dwarf2.def
index e61cfbe..c5b84f2 100644
--- a/include/dwarf2.def
+++ b/include/dwarf2.def
@@ -167,6 +167,8 @@ DW_TAG (DW_TAG_GNU_formal_parameter_pack, 0x4108)
    are properly part of DWARF 5.  */
 DW_TAG (DW_TAG_GNU_call_site, 0x4109)
 DW_TAG (DW_TAG_GNU_call_site_parameter, 0x410a)
+/* Rational constant extension, not yet specified.  */
+DW_TAG (DW_TAG_GNU_rational_constant, 0x410b)
 /* Extensions for UPC.  See: http://dwarfstd.org/doc/DWARF4.pdf.  */
 DW_TAG (DW_TAG_upc_shared_type, 0x8765)
 DW_TAG (DW_TAG_upc_strict_type, 0x8766)
@@ -404,6 +406,9 @@ DW_AT (DW_AT_VMS_rtnbeg_pd_address, 0x2201)
    See http://gcc.gnu.org/wiki/DW_AT_GNAT_descriptive_type .  */
 DW_AT (DW_AT_use_GNAT_descriptive_type, 0x2301)
 DW_AT (DW_AT_GNAT_descriptive_type, 0x2302)
+/* Rational constant extension, not yet specified.  */
+DW_TAG (DW_AT_GNU_numerator, 0x2303)
+DW_TAG (DW_AT_GNU_denominator, 0x2304)
 /* UPC extension.  */
 DW_AT (DW_AT_upc_threads_scaled, 0x3210)
 /* PGI (STMicroelectronics) extensions.  */
-- 
2.4.5


^ permalink raw reply	[flat|nested] 53+ messages in thread

* [PATCH 5/8] DWARF: describe Ada dynamic arrays as proper arrays
  2015-07-16  8:36 [PATCHES] Enhance standard DWARF for Ada Pierre-Marie de Rodat
                   ` (3 preceding siblings ...)
  2015-07-16  8:45 ` [PATCH 4/8] DWARF: add a language hook for fixed-point types Pierre-Marie de Rodat
@ 2015-07-16  8:46 ` Pierre-Marie de Rodat
  2015-07-16  8:49 ` [PATCH 6/8] create a macro for max dimensions for array descr. lang. hook Pierre-Marie de Rodat
                   ` (3 subsequent siblings)
  8 siblings, 0 replies; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-07-16  8:46 UTC (permalink / raw)
  To: GCC Patches

[-- Attachment #1: Type: text/plain, Size: 400 bytes --]

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.

-- 
Pierre-Marie de Rodat

[-- Attachment #2: 0005-DWARF-describe-Ada-dynamic-arrays-as-proper-arrays.patch --]
[-- Type: text/x-diff, Size: 12555 bytes --]

From 27e94b46e4873b175682848e87ccc60bec9f98b2 Mon Sep 17 00:00:00 2001
From: derodat <derodat@f8352e7e-cb20-0410-8ce7-b5d9e71c585c>
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 b629a7f..48b06f4 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 d146051..318f566 100644
--- a/gcc/ada/gcc-interface/misc.c
+++ b/gcc/ada/gcc-interface/misc.c
@@ -731,38 +731,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<tree> (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);
+  /* TODO??? 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;
 
@@ -770,15 +862,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.4.5


^ permalink raw reply	[flat|nested] 53+ messages in thread

* [PATCH 6/8] create a macro for max dimensions for array descr. lang. hook
  2015-07-16  8:36 [PATCHES] Enhance standard DWARF for Ada Pierre-Marie de Rodat
                   ` (4 preceding siblings ...)
  2015-07-16  8:46 ` [PATCH 5/8] DWARF: describe Ada dynamic arrays as proper arrays Pierre-Marie de Rodat
@ 2015-07-16  8:49 ` Pierre-Marie de Rodat
  2015-07-16  8:51 ` [PATCH 7/8] DWARF: add a language hook for scalar biased types Pierre-Marie de Rodat
                   ` (2 subsequent siblings)
  8 siblings, 0 replies; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-07-16  8:49 UTC (permalink / raw)
  To: GCC Patches

[-- Attachment #1: Type: text/plain, Size: 788 bytes --]

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.

-- 
Pierre-Marie de Rodat

[-- Attachment #2: 0006-DWARF-create-a-macro-for-max-dimensions-for-array-de.patch --]
[-- Type: text/x-diff, Size: 3813 bytes --]

From 5221a4fadfa84f31cc97e0eba26f8640c9abe70d Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
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 318f566..4a355a3 100644
--- a/gcc/ada/gcc-interface/misc.c
+++ b/gcc/ada/gcc-interface/misc.c
@@ -848,7 +848,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
@@ -873,7 +886,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 2653c67..d989264 100644
--- a/gcc/dwarf2out.c
+++ b/gcc/dwarf2out.c
@@ -22454,6 +22454,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 655d91a..a2049d0 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.4.5


^ permalink raw reply	[flat|nested] 53+ messages in thread

* [PATCH 7/8] DWARF: add a language hook for scalar biased types
  2015-07-16  8:36 [PATCHES] Enhance standard DWARF for Ada Pierre-Marie de Rodat
                   ` (5 preceding siblings ...)
  2015-07-16  8:49 ` [PATCH 6/8] create a macro for max dimensions for array descr. lang. hook Pierre-Marie de Rodat
@ 2015-07-16  8:51 ` Pierre-Marie de Rodat
  2015-08-18  8:16   ` Pierre-Marie de Rodat
  2015-07-16  8:53 ` [PATCH 8/8] DWARF: describe properly Ada packed arrays Pierre-Marie de Rodat
  2015-07-23 10:59 ` [PATCHES, PING] Enhance standard DWARF for Ada Pierre-Marie de Rodat
  8 siblings, 1 reply; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-07-16  8:51 UTC (permalink / raw)
  To: GCC Patches

[-- Attachment #1: Type: text/plain, Size: 1278 bytes --]

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.

-- 
Pierre-Marie de Rodat

[-- Attachment #2: 0007-DWARF-add-a-language-hook-for-scalar-biased-types.patch --]
[-- Type: text/x-diff, Size: 7903 bytes --]

From 702af856454dd74dc23979e488d311ea008981ee Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
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 +++++
 include/dwarf2.def           |  2 ++
 5 files changed, 45 insertions(+), 3 deletions(-)

diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c
index 4a355a3..47a8b1c 100644
--- a/gcc/ada/gcc-interface/misc.c
+++ b/gcc/ada/gcc-interface/misc.c
@@ -969,6 +969,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.  */
 
@@ -1268,6 +1278,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 d989264..c38f40f 100644
--- a/gcc/dwarf2out.c
+++ b/gcc/dwarf2out.c
@@ -3246,7 +3246,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);
@@ -10755,6 +10755,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;
@@ -10805,6 +10806,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:
@@ -10890,6 +10895,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;
@@ -10991,7 +11002,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);
@@ -11012,6 +11024,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;
 }
@@ -11216,7 +11234,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.  */
diff --git a/include/dwarf2.def b/include/dwarf2.def
index c5b84f2..dd5c8c1 100644
--- a/include/dwarf2.def
+++ b/include/dwarf2.def
@@ -409,6 +409,8 @@ DW_AT (DW_AT_GNAT_descriptive_type, 0x2302)
 /* Rational constant extension, not yet specified.  */
 DW_TAG (DW_AT_GNU_numerator, 0x2303)
 DW_TAG (DW_AT_GNU_denominator, 0x2304)
+/* Biased integer extension, not yet specified.  */
+DW_TAG (DW_AT_GNU_bias, 0x2305)
 /* UPC extension.  */
 DW_AT (DW_AT_upc_threads_scaled, 0x3210)
 /* PGI (STMicroelectronics) extensions.  */
-- 
2.4.5


^ permalink raw reply	[flat|nested] 53+ messages in thread

* [PATCH 8/8] DWARF: describe properly Ada packed arrays
  2015-07-16  8:36 [PATCHES] Enhance standard DWARF for Ada Pierre-Marie de Rodat
                   ` (6 preceding siblings ...)
  2015-07-16  8:51 ` [PATCH 7/8] DWARF: add a language hook for scalar biased types Pierre-Marie de Rodat
@ 2015-07-16  8:53 ` Pierre-Marie de Rodat
  2015-07-23 10:59 ` [PATCHES, PING] Enhance standard DWARF for Ada Pierre-Marie de Rodat
  8 siblings, 0 replies; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-07-16  8:53 UTC (permalink / raw)
  To: GCC Patches

[-- Attachment #1: Type: text/plain, Size: 1654 bytes --]

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.

-- 
Pierre-Marie de Rodat

[-- Attachment #2: 0008-DWARF-describe-properly-Ada-packed-arrays.patch --]
[-- Type: text/x-diff, Size: 20758 bytes --]

From 2be4df85e18e86c999d7f493366804bb57052abf Mon Sep 17 00:00:00 2001
From: derodat <derodat@f8352e7e-cb20-0410-8ce7-b5d9e71c585c>
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 8c4fdc9..a63cc29 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 48b06f4..72ddd11 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<variant_desc> , tree,
 				      tree, vec<subst_pair> );
 static void copy_and_substitute_in_size (tree, tree, vec<subst_pair> );
-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;
@@ -8725,12 +8764,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));
@@ -8744,7 +8785,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);
 }
 \f
 /* 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 47a8b1c..4a96411 100644
--- a/gcc/ada/gcc-interface/misc.c
+++ b/gcc/ada/gcc-interface/misc.c
@@ -520,9 +520,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.  */
@@ -570,7 +573,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<tree> (type);
+    }
+  return NULL_TREE;
 }
 
 /* Provide information in INFO for debugging output about the TYPE fixed-point
@@ -724,17 +738,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<tree> (type);
+  tree type = const_cast<tree> (const_type);
 
   const_tree first_dimen = NULL_TREE;
   const_tree last_dimen = NULL_TREE;
@@ -748,6 +766,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.  */
 
@@ -764,10 +796,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.  */
@@ -795,7 +827,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);
 
@@ -830,6 +862,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);
@@ -929,13 +963,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)
@@ -954,11 +988,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 7676993..cc46cf14 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.4.5


^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCH 2/8] DWARF: handle variable-length records and variant parts
  2015-07-16  8:43 ` [PATCH 2/8] DWARF: handle variable-length records and variant parts Pierre-Marie de Rodat
@ 2015-07-16  9:00   ` Pierre-Marie de Rodat
  0 siblings, 0 replies; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-07-16  9:00 UTC (permalink / raw)
  To: gcc-patches

[-- Attachment #1: Type: text/plain, Size: 6756 bytes --]

[with the patch attached, this time…]

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.

-- 
Pierre-Marie de Rodat

[-- Attachment #2: 0002-DWARF-handle-variable-length-records-and-variant-par.patch --]
[-- Type: text/x-diff, Size: 108313 bytes --]

From a7ba9b22e494c0d7db0d141008f87c33fd7864a3 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
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 971c066..bb2edcb 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
@@ -6930,6 +6931,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;
@@ -7108,7 +7111,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);
@@ -7196,7 +7199,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,
@@ -7229,7 +7232,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
@@ -7243,7 +7246,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 0032839..b3be982 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 22a9852..a39bcd0 100644
--- a/gcc/cgraph.c
+++ b/gcc/cgraph.c
@@ -1731,8 +1731,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;
 
@@ -1744,7 +1751,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 2834d57..a32521c 100644
--- a/gcc/dwarf2out.c
+++ b/gcc/dwarf2out.c
@@ -1296,6 +1296,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.  */
 
@@ -1321,6 +1322,7 @@ new_loc_descr (enum dwarf_location_atom op, unsigned HOST_WIDE_INT oprnd1,
   dw_loc_descr_ref descr = ggc_cleared_alloc<dw_loc_descr_node> ();
 
   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;
@@ -1423,6 +1425,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 ();
 }
@@ -1737,6 +1746,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);
@@ -1999,6 +2041,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
@@ -3210,6 +3268,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,
@@ -3219,10 +3279,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);
@@ -3241,13 +3304,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_ref);
 static void push_decl_scope (tree);
 static void pop_decl_scope (void);
 static dw_die_ref scope_die_for (tree, dw_die_ref);
@@ -3277,10 +3344,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);
@@ -3294,7 +3361,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);
@@ -5426,6 +5493,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
@@ -5544,6 +5620,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;
     }
@@ -7568,6 +7664,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_ref type_node,
+			       hash_map<dw_die_ref, dw_die_ref> &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_ref type_node,
+		      hash_map<dw_die_ref, dw_die_ref> &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_ref type_node,
+			       hash_map<dw_die_ref, dw_die_ref> &copied_dwarf_procs)
+{
+  dw_attr_ref 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_ref type_node,
+			      hash_map<dw_die_ref, dw_die_ref> &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.  */
 
@@ -7618,6 +7812,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<dw_die_ref, dw_die_ref> copied_dwarf_procs;
+	copy_dwarf_procs_ref_in_dies (c, type_node, copied_dwarf_procs);
+
         if (replacement != NULL)
           c = replacement;
       }
@@ -8220,6 +8421,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 ();
 	}
@@ -8603,6 +8816,23 @@ value_format (dw_attr_ref 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 ();
     }
@@ -8872,6 +9102,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.  */
 
@@ -9150,6 +9391,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 ();
 	}
@@ -11429,6 +11701,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.  */
 
@@ -14474,6 +14890,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<dw_loc_descr_ref> &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<dw_loc_descr_ref> 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<void *, free_loc_descr> (NULL);
+}
+
+
+struct dwarf_procedure_info;
 
 /* Helper structure for location descriptions generation.  */
 struct loc_descr_context
@@ -14485,61 +14963,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)
 	    {
@@ -14556,9 +15480,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:
@@ -14583,7 +15553,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)
@@ -14650,10 +15620,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:
@@ -14727,7 +15721,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;
 
@@ -14737,13 +15731,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:
@@ -14762,10 +15759,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)
@@ -14780,7 +15777,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);
@@ -14811,6 +15808,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,
@@ -14852,6 +15851,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;
@@ -14870,8 +15870,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;
 
@@ -14902,11 +15902,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 "<push literal>; 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;
 	}
 
@@ -14914,32 +15952,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;
@@ -14950,8 +15988,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;
 
@@ -14975,7 +16013,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;
 
@@ -15001,10 +16039,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;
 
@@ -15108,6 +16146,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,
@@ -15178,34 +16232,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<tree> (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;
@@ -15215,6 +16326,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);
@@ -15301,12 +16413,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;
 }
 \f
 /* The following routines define various Dwarf attributes and any data
@@ -15370,10 +16503,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;
@@ -15423,7 +16560,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)
     {
@@ -16867,6 +18020,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
@@ -16983,6 +18144,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))
     {
@@ -16999,7 +18161,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
@@ -17012,10 +18174,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);
 }
@@ -17032,22 +18201,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
@@ -17069,7 +18242,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
@@ -17279,6 +18453,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_ref attr)
+{
+  return attr->dw_attr_val.v.val_discr_list;
+}
+
 #ifdef VMS_DEBUGGING_INFO
 /* Output the debug main pointer die for VMS */
 
@@ -17738,7 +18950,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));
@@ -18257,8 +19469,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
@@ -19118,7 +20334,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
@@ -19180,7 +20396,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
@@ -19927,10 +21143,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;
 
@@ -19946,11 +21163,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);
@@ -20277,12 +21499,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);
@@ -20303,6 +21527,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:  <discr_field> == <integer_cst>
+		 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<dw_discr_list_node> ();
+	      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:
+		   <discr_field> > <integer_cst>
+		   && <discr_field> < <integer_cst>.
+		 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<dw_discr_list_node> ();
+	      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
@@ -20334,12 +21959,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
@@ -20348,8 +21976,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.  */
@@ -20370,7 +22011,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);
       }
 }
 
@@ -20706,7 +22347,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;
     }
 
@@ -20719,8 +22360,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;
     }
 
@@ -20993,7 +22634,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)
@@ -21159,7 +22800,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;
 
@@ -21272,7 +22913,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);
     }
@@ -21332,10 +22973,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;
@@ -21506,6 +23151,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
@@ -21513,7 +23159,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;
 
@@ -21908,7 +23554,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);
@@ -23502,6 +25148,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.  */
 
@@ -23513,19 +25178,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;
     }
 }
 
@@ -23676,7 +25360,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:
@@ -23684,10 +25367,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 7777251..0bd6be9 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_struct;
 
 /* 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 0d4f4a4..8079488 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.4.5


^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCH 1/8] Add a flag to control the balance between GNAT encodings, and std. DWARF
  2015-07-16  8:42 ` [PATCH 1/8] Add a flag to control the balance between GNAT encodings, and std. DWARF Pierre-Marie de Rodat
@ 2015-07-16  9:18   ` Andreas Schwab
  2015-07-16 10:16     ` Richard Biener
  0 siblings, 1 reply; 53+ messages in thread
From: Andreas Schwab @ 2015-07-16  9:18 UTC (permalink / raw)
  To: Pierre-Marie de Rodat; +Cc: GCC Patches

Pierre-Marie de Rodat <derodat@adacore.com> writes:

> +fgnat-encodings=

IMHO the option name should include "dwarf".

Andreas.

-- 
Andreas Schwab, SUSE Labs, schwab@suse.de
GPG Key fingerprint = 0196 BAD8 1CE9 1970 F4BE  1748 E4D4 88E3 0EEA B9D7
"And now for something completely different."

^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCH 1/8] Add a flag to control the balance between GNAT encodings, and std. DWARF
  2015-07-16  9:18   ` Andreas Schwab
@ 2015-07-16 10:16     ` Richard Biener
  2015-07-16 10:19       ` Pierre-Marie de Rodat
  0 siblings, 1 reply; 53+ messages in thread
From: Richard Biener @ 2015-07-16 10:16 UTC (permalink / raw)
  To: Andreas Schwab; +Cc: Pierre-Marie de Rodat, GCC Patches

On Thu, Jul 16, 2015 at 10:52 AM, Andreas Schwab <schwab@suse.de> wrote:
> Pierre-Marie de Rodat <derodat@adacore.com> writes:
>
>> +fgnat-encodings=
>
> IMHO the option name should include "dwarf".

And start with -g

Richard.

> Andreas.
>
> --
> Andreas Schwab, SUSE Labs, schwab@suse.de
> GPG Key fingerprint = 0196 BAD8 1CE9 1970 F4BE  1748 E4D4 88E3 0EEA B9D7
> "And now for something completely different."

^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCH 1/8] Add a flag to control the balance between GNAT encodings, and std. DWARF
  2015-07-16 10:16     ` Richard Biener
@ 2015-07-16 10:19       ` Pierre-Marie de Rodat
  0 siblings, 0 replies; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-07-16 10:19 UTC (permalink / raw)
  To: Richard Biener, Andreas Schwab; +Cc: GCC Patches

On 07/16/2015 12:12 PM, Richard Biener wrote:
> On Thu, Jul 16, 2015 at 10:52 AM, Andreas Schwab <schwab@suse.de> wrote:
>> Pierre-Marie de Rodat <derodat@adacore.com> writes:
>>
>>> +fgnat-encodings=
>>
>> IMHO the option name should include "dwarf".
>
> And start with -g

Thank you for your answers!

Changing the name of the option is fine with me 
(-fdwarf-gnat-encodings?), but I don't think it can start with -g as it 
also changes trees. GNAT encodings are often materialized as parallel 
types and -fgnat-encodings=minimal disables them as much as possible. As 
though I don't expect this to really change the generated code, I cannot 
guarantee it.

-- 
Pierre-Marie de Rodat

^ permalink raw reply	[flat|nested] 53+ messages in thread

* [PATCHES, PING] Enhance standard DWARF for Ada
  2015-07-16  8:36 [PATCHES] Enhance standard DWARF for Ada Pierre-Marie de Rodat
                   ` (7 preceding siblings ...)
  2015-07-16  8:53 ` [PATCH 8/8] DWARF: describe properly Ada packed arrays Pierre-Marie de Rodat
@ 2015-07-23 10:59 ` Pierre-Marie de Rodat
  2015-07-31 11:04   ` [PATCHES, PING*2] " Pierre-Marie de Rodat
  8 siblings, 1 reply; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-07-23 10:59 UTC (permalink / raw)
  To: GCC Patches; +Cc: Jakub Jelinek, Richard Biener

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>. Thanks!

-- 
Pierre-Marie de Rodat

^ permalink raw reply	[flat|nested] 53+ messages in thread

* [PATCHES, PING*2] Enhance standard DWARF for Ada
  2015-07-23 10:59 ` [PATCHES, PING] Enhance standard DWARF for Ada Pierre-Marie de Rodat
@ 2015-07-31 11:04   ` Pierre-Marie de Rodat
  2015-07-31 11:31     ` Pierre-Marie de Rodat
  0 siblings, 1 reply; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-07-31 11:04 UTC (permalink / raw)
  To: GCC Patches; +Cc: Jakub Jelinek, Richard Biener

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>. Thanks!

-- 
Pierre-Marie de Rodat

^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*2] Enhance standard DWARF for Ada
  2015-07-31 11:04   ` [PATCHES, PING*2] " Pierre-Marie de Rodat
@ 2015-07-31 11:31     ` Pierre-Marie de Rodat
  2015-08-08  9:01       ` [PATCHES, PING*3] " Pierre-Marie de Rodat
  0 siblings, 1 reply; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-07-31 11:31 UTC (permalink / raw)
  To: GCC Patches; +Cc: Jason Merill, Cary Coutant, Eric Botcazou

On 07/31/2015 12:54 PM, Pierre-Marie de Rodat wrote:
> 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>. Thanks!

As per Jakub's suggestion, pinging other maintainers: sorry for the 
double-ping. ;-)

-- 
Pierre-Marie de Rodat

^ permalink raw reply	[flat|nested] 53+ messages in thread

* [PATCHES, PING*3] Enhance standard DWARF for Ada
  2015-07-31 11:31     ` Pierre-Marie de Rodat
@ 2015-08-08  9:01       ` Pierre-Marie de Rodat
  2015-08-31  9:15         ` [PATCHES, PING*4] " Pierre-Marie de Rodat
  0 siblings, 1 reply; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-08-08  9:01 UTC (permalink / raw)
  To: gcc-patches; +Cc: Jason Merill, Cary Coutant, Eric Botcazou

Hi,

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>. Thanks!

-- 
Pierre-Marie de Rodat

^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCH 7/8] DWARF: add a language hook for scalar biased types
  2015-07-16  8:51 ` [PATCH 7/8] DWARF: add a language hook for scalar biased types Pierre-Marie de Rodat
@ 2015-08-18  8:16   ` Pierre-Marie de Rodat
  0 siblings, 0 replies; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-08-18  8:16 UTC (permalink / raw)
  To: gcc-patches

[-- Attachment #1: Type: text/plain, Size: 556 bytes --]

On 07/16/2015 10:48 AM, Pierre-Marie de Rodat wrote:
> 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.

Here's an updated, only to fix the conflict with the include/dwarf2.def 
update that occurred here: 
<https://gcc.gnu.org/ml/gcc-patches/2015-08/msg00771.html>.

Bootstrapped and regtested on x86_64-linux.

-- 
Pierre-Marie de Rodat

[-- Attachment #2: 0007-DWARF-add-a-language-hook-for-scalar-biased-types.patch --]
[-- Type: text/x-diff, Size: 7338 bytes --]

From 68841d3ba7485932fc966386b46d54a934033736 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
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 4a355a3..47a8b1c 100644
--- a/gcc/ada/gcc-interface/misc.c
+++ b/gcc/ada/gcc-interface/misc.c
@@ -969,6 +969,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.  */
 
@@ -1268,6 +1278,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 b7d72eb..be12e43 100644
--- a/gcc/dwarf2out.c
+++ b/gcc/dwarf2out.c
@@ -3283,7 +3283,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);
@@ -10792,6 +10792,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;
@@ -10842,6 +10843,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:
@@ -10926,6 +10931,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;
@@ -11027,7 +11038,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);
@@ -11048,6 +11060,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;
 }
@@ -11252,7 +11270,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.4.6


^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCH 4/8] DWARF: add a language hook for fixed-point types
  2015-07-16  8:45 ` [PATCH 4/8] DWARF: add a language hook for fixed-point types Pierre-Marie de Rodat
@ 2015-08-18  8:32   ` Pierre-Marie de Rodat
  0 siblings, 0 replies; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-08-18  8:32 UTC (permalink / raw)
  To: gcc-patches

[-- Attachment #1: Type: text/plain, Size: 501 bytes --]

On 07/16/2015 10:43 AM, Pierre-Marie de Rodat wrote:
> 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.

Here's the updated patch according to the discussion on the DWARF 
extension: <https://gcc.gnu.org/ml/gcc-patches/2015-08/msg00771.html>

Bootstrapped and regtested on x86_64-linux.

-- 
Pierre-Marie de Rodat

[-- Attachment #2: 0004-DWARF-add-a-language-hook-for-fixed-point-types.patch --]
[-- Type: text/x-diff, Size: 16898 bytes --]

From 6892758d5cf458b63c63d869bb547bf0c5369820 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
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 2fc960e..8c4fdc9 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 ab4f62b..b629a7f 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 2c68240..d146051 100644
--- a/gcc/ada/gcc-interface/misc.c
+++ b/gcc/ada/gcc-interface/misc.c
@@ -472,6 +472,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);
@@ -570,6 +573,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.  */
@@ -973,6 +1051,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);
@@ -1044,6 +1123,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 884bb8f..5a26f95 100644
--- a/gcc/dwarf2out.c
+++ b/gcc/dwarf2out.c
@@ -10790,6 +10790,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;
@@ -10816,6 +10818,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))
@@ -10874,6 +10889,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 fafa610..655d91a 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.4.6


^ permalink raw reply	[flat|nested] 53+ messages in thread

* [PATCHES, PING*4] Enhance standard DWARF for Ada
  2015-08-08  9:01       ` [PATCHES, PING*3] " Pierre-Marie de Rodat
@ 2015-08-31  9:15         ` Pierre-Marie de Rodat
  2015-10-20 20:20           ` [PATCHES, PING*5] " Pierre-Marie de Rodat
  0 siblings, 1 reply; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-08-31  9:15 UTC (permalink / raw)
  To: gcc-patches; +Cc: Jason Merill, Cary Coutant, Eric Botcazou

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>.

-- 
Pierre-Marie de Rodat

^ permalink raw reply	[flat|nested] 53+ messages in thread

* [PATCHES, PING*5] Enhance standard DWARF for Ada
  2015-08-31  9:15         ` [PATCHES, PING*4] " Pierre-Marie de Rodat
@ 2015-10-20 20:20           ` Pierre-Marie de Rodat
  2015-11-18 20:35             ` Jason Merrill
  0 siblings, 1 reply; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-10-20 20:20 UTC (permalink / raw)
  To: gcc-patches; +Cc: Jason Merill, Cary Coutant, Eric Botcazou

[-- Attachment #1: Type: text/plain, Size: 471 bytes --]

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

[-- Attachment #2: 0001-Add-a-flag-to-control-the-balance-between-GNAT-encod.patch --]
[-- Type: text/x-diff, Size: 4777 bytes --]

From 97acb58ce7cc079ff593e45e31d2fc6f44948001 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
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


[-- Attachment #3: 0002-DWARF-handle-variable-length-records-and-variant-par.patch --]
[-- Type: text/x-diff, Size: 108304 bytes --]

From fcf87271f1f46363eaeb8e23bd83c966fae1b5e4 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
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<dw_loc_descr_node> ();
 
   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<dw_die_ref, dw_die_ref> &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<dw_die_ref, dw_die_ref> &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<dw_die_ref, dw_die_ref> &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<dw_die_ref, dw_die_ref> &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<dw_die_ref, dw_die_ref> 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<dw_loc_descr_ref> &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<dw_loc_descr_ref> 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<void *, free_loc_descr> (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 "<push literal>; 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<tree> (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;
 }
 \f
 /* 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:  <discr_field> == <integer_cst>
+		 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<dw_discr_list_node> ();
+	      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:
+		   <discr_field> > <integer_cst>
+		   && <discr_field> < <integer_cst>.
+		 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<dw_discr_list_node> ();
+	      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


[-- Attachment #4: 0003-DWARF-add-a-language-hook-to-override-types-in-debug.patch --]
[-- Type: text/x-diff, Size: 15741 bytes --]

From 5ef0e7db6e4ad394deb8d22155ad5ef533a9c29a Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
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<struct lang_type> (); \
-  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<struct lang_type> ();
+  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


[-- Attachment #5: 0004-DWARF-add-a-language-hook-for-fixed-point-types.patch --]
[-- Type: text/x-diff, Size: 16898 bytes --]

From 9c511761af1d8a532c4c5070dce80bdd8b21399d Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
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


[-- Attachment #6: 0005-DWARF-describe-Ada-dynamic-arrays-as-proper-arrays.patch --]
[-- Type: text/x-diff, Size: 12551 bytes --]

From 7df1dd8036fa5aad98c0d93c9571768a4aa24664 Mon Sep 17 00:00:00 2001
From: derodat <derodat@f8352e7e-cb20-0410-8ce7-b5d9e71c585c>
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<tree> (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


[-- Attachment #7: 0006-DWARF-create-a-macro-for-max-dimensions-for-array-de.patch --]
[-- Type: text/x-diff, Size: 3813 bytes --]

From 49de7b666262df4f4bdf86622485c1d7663e6f38 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
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


[-- Attachment #8: 0007-DWARF-add-a-language-hook-for-scalar-biased-types.patch --]
[-- Type: text/x-diff, Size: 7338 bytes --]

From 74e7619587cb45a04b362806ae4bb9d55ed25e07 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
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


[-- Attachment #9: 0008-DWARF-describe-properly-Ada-packed-arrays.patch --]
[-- Type: text/x-diff, Size: 20758 bytes --]

From ba3bccbe40571753befb83a6b64e10a968242639 Mon Sep 17 00:00:00 2001
From: derodat <derodat@f8352e7e-cb20-0410-8ce7-b5d9e71c585c>
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<variant_desc> , tree,
 				      tree, vec<subst_pair> );
 static void copy_and_substitute_in_size (tree, tree, vec<subst_pair> );
-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);
 }
 \f
 /* 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<tree> (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<tree> (type);
+  tree type = const_cast<tree> (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


^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*5] Enhance standard DWARF for Ada
  2015-10-20 20:20           ` [PATCHES, PING*5] " Pierre-Marie de Rodat
@ 2015-11-18 20:35             ` Jason Merrill
  2015-11-23 14:01               ` Pierre-Marie de Rodat
  0 siblings, 1 reply; 53+ messages in thread
From: Jason Merrill @ 2015-11-18 20:35 UTC (permalink / raw)
  To: Pierre-Marie de Rodat, gcc-patches; +Cc: Cary Coutant, Eric Botcazou

On 10/20/2015 04:13 PM, Pierre-Marie de Rodat wrote:

Sorry about the slow review on these patches.  In future please feel 
free to ping me as often as once a week.

> +  /* DWARF operations all work on signed integers.

Note that this will no longer be the case in DWARF 5, where stack 
elements have associated types.  Let's add a comment about that so 
perhaps we can remove the workaround in a future release.

> +  /* ??? 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?  */

Might as well free them if we know they're garbage, it lets us reuse 
that memory sooner.

> +  /* Trailing nops from loc_descritor_from_tree (if any) cannot be removed

missing 'p' in loc_descriptor_from_tree.

> +  /* 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;

I'm not excited about adding another couple of words to every loc insn 
for uses that occur so rarely.

dw_loc_frame_offset seems to be primarily used for checking, can we make 
it conditional on ENABLE_CHECKING and use a hash_set to remember already 
visited nodes?

Instead of dw_loc_frame_offset_increment, can we look up the number of 
arguments from the callee?

> +  /* Return a type to used in the debug info instead of TYPE, or NULL_TREE to

"to use"

> +         /* Arbitrary scale factors cannot be describe in standard DWARF,

"described"

Jason

^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*5] Enhance standard DWARF for Ada
  2015-11-18 20:35             ` Jason Merrill
@ 2015-11-23 14:01               ` Pierre-Marie de Rodat
  2015-11-23 21:11                 ` Jason Merrill
  0 siblings, 1 reply; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-11-23 14:01 UTC (permalink / raw)
  To: Jason Merrill, gcc-patches; +Cc: Cary Coutant, Eric Botcazou

[-- Attachment #1: Type: text/plain, Size: 2932 bytes --]

Thank you for reviewing, Jason!

On 11/18/2015 09:35 PM, Jason Merrill wrote:
> Sorry about the slow review on these patches.  In future please feel
> free to ping me as often as once a week.

Sure, will do. :-) Do you think the other patches could make it before 
the branch? (if they could, I will rebase+retest them as quick as possible).

>> +  /* DWARF operations all work on signed integers.
>
> Note that this will no longer be the case in DWARF 5, where stack
> elements have associated types.  Let's add a comment about that so
> perhaps we can remove the workaround in a future release.

I was not aware of that, thanks. I prefixed the comment with “Until 
DWARFv4, […]”.

>> +  /* ??? 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?  */
>
> Might as well free them if we know they're garbage, it lets us reuse
> that memory sooner.

Understood, thanks. I stripped “???” and the question from this comment.

>> +  /* Trailing nops from loc_descritor_from_tree (if any) cannot be
>> removed
>
> missing 'p' in loc_descriptor_from_tree.

Fixed.

> I'm not excited about adding another couple of words to every loc insn
> for uses that occur so rarely.
>
> dw_loc_frame_offset seems to be primarily used for checking, can we make
> it conditional on ENABLE_CHECKING and use a hash_set to remember already
> visited nodes?
>
> Instead of dw_loc_frame_offset_increment, can we look up the number of
> arguments from the callee?

dw_loc_frame_offset was indeed used for checking, but it was also used 
as a condition to stop expression traversal in resolve_args_picking. 
I’ve added ENABLE_CHECKING anyway and split resolve_args_picking in two 
parts: one wrapper function that calls the other with a set of visited 
nodes, so that we don’t need dw_loc_frame_offset anymore in non-checking 
mode.

For dw_loc_frame_offest_increment, I introduced a hash table 
(dwarf_proc_decl_table & lookup_dwarf_proc_decl) where we remember from 
which FUNCTION_DECL we got DWARF procedures. This way, we can indeed 
lookup up the number of arguments from the callee.

So the only new field left is frame_offset_rel, which just reserves a 
previously allocated but unused bit.

>> +  /* Return a type to used in the debug info instead of TYPE, or
>> NULL_TREE to
>
> "to use"

Fixed.

>> +         /* Arbitrary scale factors cannot be describe in standard
>> DWARF,
>
> "described"

Fixed.

The updated (rebased) patches are attached. For the record I had to 
solve two minor conflicts in the process:

   * one in the first patch, for a reformatting around the introduction 
of gnat_encodings in gcc/ada/gcc-interface/misc.c;

   * one in the 5th patch, for the build_component_ref recent change in 
gcc/ada/gcc-interface/utils2.c.

Bootstrapped and regtested on x86_64-linux.

-- 
Pierre-Marie de Rodat

[-- Attachment #2: 0001-Add-a-flag-to-control-the-balance-between-GNAT-encod.patch --]
[-- Type: text/x-diff, Size: 4634 bytes --]

From 8e458936ec31bdf4b28e5bea4f9b54cabb7350d5 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
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 2a65142..ef0fe3f 100644
--- a/gcc/ada/gcc-interface/misc.c
+++ b/gcc/ada/gcc-interface/misc.c
@@ -68,7 +68,8 @@ extern const char **gnat_argv;
 
 /* Ada code requires variables for these settings rather than elements
    of the global_options structure because they are imported.  */
-int gnat_encodings = 0;
+#undef gnat_encodings
+enum dwarf_gnat_encodings gnat_encodings = DWARF_GNAT_ENCODINGS_DEFAULT;
 
 #undef optimize
 int optimize;
@@ -276,6 +277,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 3eb520e..08c3d90 100644
--- a/gcc/common.opt
+++ b/gcc/common.opt
@@ -161,6 +161,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
@@ -1326,6 +1331,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 0f1c713..3583627 100644
--- a/gcc/defaults.h
+++ b/gcc/defaults.h
@@ -1488,4 +1488,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 88a760c..9c818c7 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.2


[-- Attachment #3: 0002-DWARF-handle-variable-length-records-and-variant-par.patch --]
[-- Type: text/x-diff, Size: 110714 bytes --]

From fbf6a3f1d50da4c8fb524b15b889419e77663345 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
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 and
	dw_loc_frame_offset (only for checking) 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.
	(tree_hasher): New.
	(tree_hasher::hash): New.
	(tree_hasher::equal): New.
	(dwarf_proc_decl_table): New.
	(lookup_dwarf_proc_decl): New.
	(equate_decl_to_dwarf_proc): New.
	(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_1): 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.
	(dwarf2out_init): Allocate dwarf_proc_decl_table.
	(dwarf2out_c_finalize): Reset dwarf_proc_decl_table.

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                        | 2046 +++++++++++++++++++++++++++++---
 gcc/dwarf2out.h                        |   50 +-
 gcc/function.h                         |    6 +
 gcc/stor-layout.c                      |    9 +
 gcc/testsuite/gnat.dg/specs/debug1.ads |    2 +-
 8 files changed, 1997 insertions(+), 155 deletions(-)

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 75e9e33..f347fa3 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -3561,10 +3561,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
@@ -6976,6 +6977,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;
@@ -7158,7 +7161,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);
@@ -7248,7 +7251,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,
@@ -7281,7 +7284,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
@@ -7295,7 +7298,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 aa2fdf2..13840ee 100644
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -1348,8 +1348,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
@@ -1884,7 +1886,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 b1228a2..5420353 100644
--- a/gcc/cgraph.c
+++ b/gcc/cgraph.c
@@ -1706,8 +1706,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;
 
@@ -1719,7 +1726,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 f184750..34699c1 100644
--- a/gcc/dwarf2out.c
+++ b/gcc/dwarf2out.c
@@ -1299,6 +1299,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.  */
 
@@ -1324,6 +1325,9 @@ new_loc_descr (enum dwarf_location_atom op, unsigned HOST_WIDE_INT oprnd1,
   dw_loc_descr_ref descr = ggc_cleared_alloc<dw_loc_descr_node> ();
 
   descr->dw_loc_opc = op;
+#if ENABLE_CHECKING
+  descr->dw_loc_frame_offset = -1;
+#endif
   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;
@@ -1426,6 +1430,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 ();
 }
@@ -1740,6 +1751,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);
@@ -2002,6 +2046,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
@@ -2844,6 +2904,18 @@ struct decl_die_hasher : ggc_ptr_hash<die_node>
    The key is a DECL_UID() which is a unique number identifying each decl.  */
 static GTY (()) hash_table<decl_die_hasher> *decl_die_table;
 
+struct tree_hasher : ggc_ptr_hash<tree_node>
+{
+  typedef dw_die_ref compare_type;
+
+  static hashval_t hash (tree);
+  static bool equal (tree, die_node *);
+};
+
+/* A hash table to find which FUNCTION_DECL some DWARF procedure
+   represents.  */
+static GTY (()) hash_table<tree_hasher> *dwarf_proc_decl_table;
+
 struct block_die_hasher : ggc_ptr_hash<die_struct>
 {
   static hashval_t hash (die_struct *);
@@ -3135,6 +3207,8 @@ static dw_die_ref strip_naming_typedef (tree, dw_die_ref);
 static dw_die_ref lookup_type_die_strip_naming_typedef (tree);
 static void equate_type_number_to_die (tree, dw_die_ref);
 static dw_die_ref lookup_decl_die (tree);
+static tree lookup_dwarf_proc_decl (dw_die_ref);
+static inline void equate_decl_to_dwarf_proc (tree decl, dw_die_ref die);
 static var_loc_list *lookup_decl_loc (const_tree);
 static void equate_decl_number_to_die (tree, dw_die_ref);
 static struct var_loc_node *add_var_loc_to_decl (tree, rtx, const char *);
@@ -3241,6 +3315,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,
@@ -3250,10 +3326,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);
@@ -3271,13 +3350,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);
@@ -3307,10 +3390,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);
@@ -3324,7 +3407,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);
@@ -5062,6 +5145,39 @@ lookup_decl_die (tree decl)
   return decl_die_table->find_with_hash (decl, DECL_UID (decl));
 }
 
+/* Returns a hash value for X (which really is a tree_node).  */
+
+inline hashval_t
+tree_hasher::hash (tree x)
+{
+  return DECL_UID (x);
+}
+
+/* Return nonzero if DECL_UID (X) is the same as decl_id of die_struct Y.  */
+
+inline bool
+tree_hasher::equal (tree x, die_node *y)
+{
+  return DECL_UID (x) == y->decl_id;
+}
+
+/* Return the FUNCTION_DECL for which DIE (a DWARF procedure) was created.  */
+
+static inline tree
+lookup_dwarf_proc_decl (dw_die_ref die)
+{
+  return dwarf_proc_decl_table->find_with_hash (die, die->decl_id);
+}
+
+/* Equate a DECL to a given DWARF procedure.  */
+
+static inline void
+equate_decl_to_dwarf_proc (tree decl, dw_die_ref die)
+{
+  *dwarf_proc_decl_table->find_slot_with_hash (die, die->decl_id, INSERT)
+    = decl;
+}
+
 /* Returns a hash value for X (which really is a var_loc_list).  */
 
 inline hashval_t
@@ -5457,6 +5573,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
@@ -5575,6 +5700,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;
     }
@@ -7597,6 +7742,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<dw_die_ref, dw_die_ref> &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<dw_die_ref, dw_die_ref> &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<dw_die_ref, dw_die_ref> &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<dw_die_ref, dw_die_ref> &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.  */
 
@@ -7647,6 +7890,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<dw_die_ref, dw_die_ref> copied_dwarf_procs;
+	copy_dwarf_procs_ref_in_dies (c, type_node, copied_dwarf_procs);
+
         if (replacement != NULL)
           c = replacement;
       }
@@ -8249,6 +8499,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 ();
 	}
@@ -8632,6 +8894,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 ();
     }
@@ -8901,6 +9180,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.  */
 
@@ -9179,6 +9469,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 ();
 	}
@@ -11483,6 +11804,151 @@ 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);
+
+  /* Until DWARFv4, 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.  */
 
@@ -14527,6 +14993,67 @@ 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<dw_loc_descr_ref> &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.  */
+  hash_set<dw_loc_descr_ref> 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<void *, free_loc_descr> (NULL);
+}
+
+
+struct dwarf_procedure_info;
 
 /* Helper structure for location descriptions generation.  */
 struct loc_descr_context
@@ -14538,48 +15065,524 @@ 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)
+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;
+
+  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)
     {
-      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;
+      equate_decl_number_to_die (fndecl, dwarf_proc_die);
+      equate_decl_to_dwarf_proc (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;
+}
 
-  switch (TREE_CODE (loc))
+/* 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);
+}
+
+/* Helper for resolve_args_picking.  Stop when coming across VISITED nodes.  */
+
+static bool
+resolve_args_picking_1 (dw_loc_descr_ref loc, unsigned initial_frame_offset,
+			struct dwarf_procedure_info *dpi,
+			hash_set<dw_loc_descr_ref> &visited)
+{
+  /* 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;)
+    {
+      /* If we already met this node, there is nothing to compute anymore.  */
+      if (visited.contains (l))
+	{
+#if ENABLE_CHECKING
+	  /* Make sure that the stack size is consistent wherever the execution
+	     flow comes from.  */
+	  gcc_assert ((unsigned) l->dw_loc_frame_offset == frame_offset_);
+#endif
+	  break;
+	}
+      visited.add (l);
+#if ENABLE_CHECKING
+      l->dw_loc_frame_offset = frame_offset_;
+#endif
+
+      /* 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:
+	  {
+	    /* The called DWARF procedure consumes one stack slot per argument
+	       and returns one stack slot.  */
+	    tree func
+	      = lookup_dwarf_proc_decl (l->dw_loc_oprnd1.v.val_die_ref.die);
+
+	    frame_offset += 1;
+	    for (tree args = DECL_ARGUMENTS (func);
+		 args != NULL;
+		 args = DECL_CHAIN (args))
+	      frame_offset_--;
+	    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_1 (l->dw_loc_next, frame_offset_, dpi,
+				       visited))
+	    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;
+}
+
+/* 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)
+{
+  hash_set<dw_loc_descr_ref> visited;
+
+  return resolve_args_picking_1 (loc, initial_frame_offset, dpi, visited);
+}
+
+/* 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_descriptor_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");
@@ -14609,9 +15612,49 @@ 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;
+	  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:
@@ -14636,7 +15679,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)
@@ -14703,10 +15746,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:
@@ -14780,7 +15847,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;
 
@@ -14790,13 +15857,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:
@@ -14815,10 +15885,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)
@@ -14833,7 +15903,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);
@@ -14864,6 +15934,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,
@@ -14905,6 +15977,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;
@@ -14923,8 +15996,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;
 
@@ -14955,11 +16028,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 "<push literal>; 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;
 	}
 
@@ -14967,32 +16078,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;
@@ -15003,8 +16114,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;
 
@@ -15028,7 +16139,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;
 
@@ -15054,10 +16165,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;
 
@@ -15160,6 +16271,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,
@@ -15230,34 +16357,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<tree> (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;
@@ -15267,6 +16451,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);
@@ -15353,12 +16538,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 */
 
-  object_offset_in_bytes
-    = wi::lrshift (object_offset_in_bits, LOG2_BITS_PER_UNIT);
-  return object_offset_in_bytes.to_shwi ();
+  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);
+
+  /* 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;
 }
 \f
 /* The following routines define various Dwarf attributes and any data
@@ -15422,10 +16628,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;
@@ -15475,7 +16685,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 +18151,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 +18275,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 +18292,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 +18305,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 +18332,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 +18373,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 +18584,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 +19081,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 +19600,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 +20465,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 +20527,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
@@ -19988,10 +21277,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;
 
@@ -20007,11 +21297,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);
@@ -20336,12 +21631,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);
@@ -20362,6 +21659,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:  <discr_field> == <integer_cst>
+		 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<dw_discr_list_node> ();
+	      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:
+		   <discr_field> > <integer_cst>
+		   && <discr_field> < <integer_cst>.
+		 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<dw_discr_list_node> ();
+	      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
@@ -20393,12 +22091,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
@@ -20407,8 +22108,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.  */
@@ -20429,7 +22143,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);
       }
 }
 
@@ -20763,7 +22477,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;
     }
 
@@ -20776,8 +22490,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;
     }
 
@@ -21051,7 +22765,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)
@@ -21217,7 +22931,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;
 
@@ -21330,7 +23044,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);
     }
@@ -21390,10 +23104,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;
@@ -21564,6 +23282,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
@@ -21571,7 +23290,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;
 
@@ -21971,7 +23690,7 @@ dwarf2out_decl (tree decl)
       return;
     }
 
-  gen_decl_die (decl, NULL, context_die);
+  gen_decl_die (decl, NULL, NULL, context_die);
 
   if (flag_checking)
     {
@@ -23270,6 +24989,9 @@ dwarf2out_init (const char *filename ATTRIBUTE_UNUSED)
   /* Allocate the decl_loc_table.  */
   decl_loc_table = hash_table<decl_loc_hasher>::create_ggc (10);
 
+  /* Allocate the dwarf_proc_decl_table.  */
+  dwarf_proc_decl_table = hash_table<tree_hasher>::create_ggc (10);
+
   /* Allocate the cached_dw_loc_list_table.  */
   cached_dw_loc_list_table = hash_table<dw_loc_list_hasher>::create_ggc (10);
 
@@ -23592,6 +25314,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.  */
 
@@ -23603,19 +25344,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;
     }
 }
 
@@ -23766,7 +25526,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:
@@ -23774,10 +25533,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:
@@ -25654,6 +27419,7 @@ dwarf2out_c_finalize (void)
   limbo_die_list = NULL;
   file_table = NULL;
   decl_die_table = NULL;
+  dwarf_proc_decl_table = NULL;
   common_block_die_table = NULL;
   decl_loc_table = NULL;
   call_arg_locations = NULL;
diff --git a/gcc/dwarf2out.h b/gcc/dwarf2out.h
index 4fe3527..4303e60 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,35 @@ 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;
+#if ENABLE_CHECKING
+  /* 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;
+#endif
   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 b2e4f71..8c8a279 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 fac3895..2470814 100644
--- a/gcc/stor-layout.c
+++ b/gcc/stor-layout.c
@@ -286,13 +286,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.2


[-- Attachment #4: 0003-DWARF-add-a-language-hook-to-override-types-in-debug.patch --]
[-- Type: text/x-diff, Size: 15753 bytes --]

From 735d61433ddb50db8a97f2324e0c45c6ddcd3f02 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
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 4e368f0..2c858f3 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<struct lang_type> (); \
-  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 f347fa3..52890fb 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -1842,6 +1842,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);
@@ -3282,6 +3284,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);
 	      TYPE_REVERSE_STORAGE_ORDER (gnu_type)
 		= Reverse_Storage_Order (gnat_entity);
diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c
index ef0fe3f..e9df63c 100644
--- a/gcc/ada/gcc-interface/misc.c
+++ b/gcc/ada/gcc-interface/misc.c
@@ -524,6 +524,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.  */
@@ -565,6 +569,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.  */
@@ -697,6 +710,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;
 }
 
@@ -947,6 +987,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<struct lang_type> ();
+  return TYPE_LANG_SPECIFIC (node);
+}
+
 /* Definitions for our language-specific hooks.  */
 
 #undef  LANG_HOOKS_NAME
@@ -999,6 +1050,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 13840ee..ac3e3cf 100644
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -1278,6 +1278,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");
@@ -1348,10 +1350,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
@@ -1367,6 +1367,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 (),
@@ -1375,19 +1377,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 34699c1..2e58e38 100644
--- a/gcc/dwarf2out.c
+++ b/gcc/dwarf2out.c
@@ -11123,6 +11123,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
@@ -19115,6 +19123,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 4303e60..7f4a24d 100644
--- a/gcc/dwarf2out.h
+++ b/gcc/dwarf2out.h
@@ -325,6 +325,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
@@ -333,6 +335,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..e80993b 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 use 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.2


[-- Attachment #5: 0004-DWARF-add-a-language-hook-for-fixed-point-types.patch --]
[-- Type: text/x-diff, Size: 16898 bytes --]

From f217690cb27ea27c787bf0ef1bd17e4971587479 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
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 2c858f3..1f5622d 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 52890fb..a2e8920 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -44,6 +44,7 @@
 #include "repinfo.h"
 #include "snames.h"
 #include "uintp.h"
+#include "urealp.h"
 #include "fe.h"
 #include "sinfo.h"
 #include "einfo.h"
@@ -1615,13 +1616,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 e9df63c..48e98fd 100644
--- a/gcc/ada/gcc-interface/misc.c
+++ b/gcc/ada/gcc-interface/misc.c
@@ -480,6 +480,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);
@@ -578,6 +581,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.  */
@@ -981,6 +1059,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);
@@ -1052,6 +1131,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 2e58e38..32b01b9 100644
--- a/gcc/dwarf2out.c
+++ b/gcc/dwarf2out.c
@@ -10846,6 +10846,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;
@@ -10872,6 +10874,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))
@@ -10930,6 +10945,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 described 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 7f4a24d..9173076 100644
--- a/gcc/dwarf2out.h
+++ b/gcc/dwarf2out.h
@@ -342,6 +342,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 e80993b..f84bdf6 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.2


[-- Attachment #6: 0005-DWARF-describe-Ada-dynamic-arrays-as-proper-arrays.patch --]
[-- Type: text/x-diff, Size: 12529 bytes --]

From 3289fcbb94773f623101749fa59f371c6e9c9e64 Mon Sep 17 00:00:00 2001
From: derodat <derodat@f8352e7e-cb20-0410-8ce7-b5d9e71c585c>
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 a2e8920..72ab505 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -2270,22 +2270,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);
@@ -2518,14 +2527,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 48e98fd..279e5fc 100644
--- a/gcc/ada/gcc-interface/misc.c
+++ b/gcc/ada/gcc-interface/misc.c
@@ -739,38 +739,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<tree> (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;
 
@@ -778,15 +870,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, thinptr_bound_field,
+				   false);
+	  thinptr_bound_field = DECL_CHAIN (thinptr_bound_field);
+
+	  info->dimen[i].upper_bound
+	    = build_component_ref (thinptr_template_expr, 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.2


[-- Attachment #7: 0006-DWARF-create-a-macro-for-max-dimensions-for-array-de.patch --]
[-- Type: text/x-diff, Size: 3813 bytes --]

From af68a98e87f55c902f4d28fc1153a3c74cc59474 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
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 279e5fc..891ca3f 100644
--- a/gcc/ada/gcc-interface/misc.c
+++ b/gcc/ada/gcc-interface/misc.c
@@ -856,7 +856,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
@@ -881,7 +894,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 32b01b9..6d4d60f 100644
--- a/gcc/dwarf2out.c
+++ b/gcc/dwarf2out.c
@@ -22583,6 +22583,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 9173076..24a384c 100644
--- a/gcc/dwarf2out.h
+++ b/gcc/dwarf2out.h
@@ -316,6 +316,8 @@ enum array_descr_ordering
   array_descr_ordering_column_major
 };
 
+#define DWARF2OUT_ARRAY_DESCR_INFO_MAX_DIMEN 16
+
 struct array_descr_info
 {
   int ndimensions;
@@ -339,7 +341,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.2


[-- Attachment #8: 0007-DWARF-add-a-language-hook-for-scalar-biased-types.patch --]
[-- Type: text/x-diff, Size: 7338 bytes --]

From 3c0ac253df32662c894913b8fc633447a0b1861c Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
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 891ca3f..269960f 100644
--- a/gcc/ada/gcc-interface/misc.c
+++ b/gcc/ada/gcc-interface/misc.c
@@ -977,6 +977,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.  */
 
@@ -1276,6 +1286,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 6d4d60f..251a405 100644
--- a/gcc/dwarf2out.c
+++ b/gcc/dwarf2out.c
@@ -3293,7 +3293,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);
@@ -10848,6 +10848,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;
@@ -10898,6 +10899,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:
@@ -10982,6 +10987,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;
@@ -11083,7 +11094,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);
@@ -11104,6 +11116,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;
 }
@@ -11318,7 +11336,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 f84bdf6..95d5840 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.2


[-- Attachment #9: 0008-DWARF-describe-properly-Ada-packed-arrays.patch --]
[-- Type: text/x-diff, Size: 20757 bytes --]

From 6d02be94ee3643b17460b0a41ddb93ca588acf82 Mon Sep 17 00:00:00 2001
From: derodat <derodat@f8352e7e-cb20-0410-8ce7-b5d9e71c585c>
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 1f5622d..e82ab4f 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 72ab505..fde8e03 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -195,7 +195,7 @@ static tree get_rep_part (tree);
 static tree create_variant_part_from (tree, vec<variant_desc> , tree,
 				      tree, vec<subst_pair> );
 static void copy_and_substitute_in_size (tree, tree, vec<subst_pair> );
-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
@@ -1802,9 +1802,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:
 
@@ -1837,6 +1838,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);
@@ -1881,8 +1886,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);
 	    }
@@ -2237,6 +2247,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);
 
@@ -2599,6 +2616,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);
@@ -2673,17 +2701,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)));
 		}
@@ -2694,6 +2725,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))
@@ -2750,6 +2788,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;
@@ -8779,12 +8818,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));
@@ -8798,7 +8839,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);
 }
 \f
 /* 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 269960f..adaea7f 100644
--- a/gcc/ada/gcc-interface/misc.c
+++ b/gcc/ada/gcc-interface/misc.c
@@ -528,9 +528,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.  */
@@ -578,7 +581,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<tree> (type);
+    }
+  return NULL_TREE;
 }
 
 /* Provide information in INFO for debugging output about the TYPE fixed-point
@@ -732,17 +746,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<tree> (type);
+  tree type = const_cast<tree> (const_type);
 
   const_tree first_dimen = NULL_TREE;
   const_tree last_dimen = NULL_TREE;
@@ -756,6 +774,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.  */
 
@@ -772,10 +804,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.  */
@@ -803,7 +835,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);
 
@@ -838,6 +870,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);
@@ -937,13 +971,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)
@@ -962,11 +996,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 ac3e3cf..198fc7e 100644
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -1281,7 +1281,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.2


^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*5] Enhance standard DWARF for Ada
  2015-11-23 14:01               ` Pierre-Marie de Rodat
@ 2015-11-23 21:11                 ` Jason Merrill
  2015-11-24  9:19                   ` Pierre-Marie de Rodat
  0 siblings, 1 reply; 53+ messages in thread
From: Jason Merrill @ 2015-11-23 21:11 UTC (permalink / raw)
  To: Pierre-Marie de Rodat, gcc-patches; +Cc: Cary Coutant, Eric Botcazou

On 11/23/2015 08:53 AM, Pierre-Marie de Rodat wrote:
>  Do you think the other patches could make it before the branch? (if they could, I will rebase+retest them as quick as possible).

Probably, yes.  I can't find the DW_AT_static_link patch, though; it 
doesn't seem to have been attached to your initial mail.

> +      /* If we already met this node, there is nothing to compute anymore.  */
> +      if (visited.contains (l))
> +       {
> +#if ENABLE_CHECKING
> +         /* Make sure that the stack size is consistent wherever the execution
> +            flow comes from.  */
> +         gcc_assert ((unsigned) l->dw_loc_frame_offset == frame_offset_);
> +#endif
> +         break;
> +       }
> +      visited.add (l);

The 'add' function returns whether or not the set already contained the 
entry, so you don't need to also call 'contains'.

> +           /* The called DWARF procedure consumes one stack slot per argument
> +              and returns one stack slot.  */
> +           tree func
> +             = lookup_dwarf_proc_decl (l->dw_loc_oprnd1.v.val_die_ref.die);
> +
> +           frame_offset += 1;
> +           for (tree args = DECL_ARGUMENTS (func);
> +                args != NULL;
> +                args = DECL_CHAIN (args))
> +             frame_offset_--;

Can you avoid the new hash table by counting the 
DW_TAG_formal_parameters instead of the DECL_ARGUMENTS?

Jason

^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*5] Enhance standard DWARF for Ada
  2015-11-23 21:11                 ` Jason Merrill
@ 2015-11-24  9:19                   ` Pierre-Marie de Rodat
  2015-11-25 18:36                     ` Jason Merrill
  0 siblings, 1 reply; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-11-24  9:19 UTC (permalink / raw)
  To: Jason Merrill, gcc-patches; +Cc: Cary Coutant, Eric Botcazou

On 11/23/2015 10:08 PM, Jason Merrill wrote:
> On 11/23/2015 08:53 AM, Pierre-Marie de Rodat wrote:
>>  Do you think the other patches could make it before the branch? (if
>> they could, I will rebase+retest them as quick as possible).
>
> Probably, yes.  I can't find the DW_AT_static_link patch, though; it
> doesn't seem to have been attached to your initial mail.

Fantastic! I’ll rebase them and resubmit them.

> The 'add' function returns whether or not the set already contained the
> entry, so you don't need to also call 'contains'.

Oh indeed, thanks! Will fix.

> Can you avoid the new hash table by counting the
> DW_TAG_formal_parameters instead of the DECL_ARGUMENTS?

I’m not sure what you mean: DWARF procedures (DW_TAG_variable or 
DW_TAG_dwarf_procedure, depending on the version) don’t have child DIEs, 
so there is no DW_TAG_formal_parameters.

Actually, even though my patches introduce DWARF procedures for only one 
case (size functions from stor-layout.c), they don’t necessarily come 
from code generation (GENERIC): they are just a way to factorize common 
DWARF operations. Thinking more about it, it may be more sound to store 
stack slot diffs instead of FUNCTION_DECL nodes in dwarf_proc_decl_table.

-- 
Pierre-Marie de Rodat

^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*5] Enhance standard DWARF for Ada
  2015-11-24  9:19                   ` Pierre-Marie de Rodat
@ 2015-11-25 18:36                     ` Jason Merrill
  2015-11-26 12:37                       ` Pierre-Marie de Rodat
  0 siblings, 1 reply; 53+ messages in thread
From: Jason Merrill @ 2015-11-25 18:36 UTC (permalink / raw)
  To: Pierre-Marie de Rodat, gcc-patches; +Cc: Cary Coutant, Eric Botcazou

On 11/24/2015 04:17 AM, Pierre-Marie de Rodat wrote:
> On 11/23/2015 10:08 PM, Jason Merrill wrote:
>> On 11/23/2015 08:53 AM, Pierre-Marie de Rodat wrote:
>>>  Do you think the other patches could make it before the branch? (if
>>> they could, I will rebase+retest them as quick as possible).
>>
>> Probably, yes.  I can't find the DW_AT_static_link patch, though; it
>> doesn't seem to have been attached to your initial mail.
>
> Fantastic! I’ll rebase them and resubmit them.
>
>> The 'add' function returns whether or not the set already contained the
>> entry, so you don't need to also call 'contains'.
>
> Oh indeed, thanks! Will fix.
>
>> Can you avoid the new hash table by counting the
>> DW_TAG_formal_parameters instead of the DECL_ARGUMENTS?
>
> I’m not sure what you mean: DWARF procedures (DW_TAG_variable or
> DW_TAG_dwarf_procedure, depending on the version) don’t have child DIEs,
> so there is no DW_TAG_formal_parameters.

Ah, right.

> Actually, even though my patches introduce DWARF procedures for only one
> case (size functions from stor-layout.c), they don’t necessarily come
> from code generation (GENERIC): they are just a way to factorize common
> DWARF operations. Thinking more about it, it may be more sound to store
> stack slot diffs instead of FUNCTION_DECL nodes in dwarf_proc_decl_table.

Makes sense.

Jason


^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*5] Enhance standard DWARF for Ada
  2015-11-25 18:36                     ` Jason Merrill
@ 2015-11-26 12:37                       ` Pierre-Marie de Rodat
  2015-12-03 10:35                         ` [PATCHES, PING] " Pierre-Marie de Rodat
  2015-12-11 20:25                         ` [PATCHES, PING*5] " Jason Merrill
  0 siblings, 2 replies; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-11-26 12:37 UTC (permalink / raw)
  To: Jason Merrill, gcc-patches; +Cc: Cary Coutant, Eric Botcazou

[-- Attachment #1: Type: text/plain, Size: 652 bytes --]

On 11/25/2015 07:35 PM, Jason Merrill wrote:
>>> Actually, even though my patches introduce DWARF procedures for only one
>> case (size functions from stor-layout.c), they don’t necessarily come
>> from code generation (GENERIC): they are just a way to factorize common
>> DWARF operations. Thinking more about it, it may be more sound to store
>> stack slot diffs instead of FUNCTION_DECL nodes in dwarf_proc_decl_table.
>
> Makes sense.

Done! (I repalced the dwarf_proc_decl_table hash table with a 
dwarf_proc_stack_usage_map hash_map) Here's an update for the only 
affected patch. Regtested again on x86_64-linux.

-- 
Pierre-Marie de Rodat

[-- Attachment #2: 0002-DWARF-handle-variable-length-records-and-variant-par.patch --]
[-- Type: text/x-diff, Size: 110825 bytes --]

From 46826e401566c26ad77e2bb6b782cc6034b96fd3 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
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 and
	dw_loc_frame_offset (only for checking) 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.
	(dwarf_proc_stack_usage_map): New.
	(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_1): 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.
	(dwarf2out_init): Allocate dwarf_proc_stack_usage_map.
	(dwarf2out_c_finalize): Deallocate and reset
	dwarf_proc_stack_usage_map.

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                        | 2066 +++++++++++++++++++++++++++++---
 gcc/dwarf2out.h                        |   50 +-
 gcc/function.h                         |    6 +
 gcc/stor-layout.c                      |    9 +
 gcc/testsuite/gnat.dg/specs/debug1.ads |    2 +-
 8 files changed, 1985 insertions(+), 187 deletions(-)

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 3ae079f..629fb19 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -3562,10 +3562,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
@@ -7030,6 +7031,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;
@@ -7212,7 +7215,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);
@@ -7302,7 +7305,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,
@@ -7335,7 +7338,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
@@ -7349,7 +7352,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 aa2fdf2..13840ee 100644
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -1348,8 +1348,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
@@ -1884,7 +1886,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 b1228a2..5420353 100644
--- a/gcc/cgraph.c
+++ b/gcc/cgraph.c
@@ -1706,8 +1706,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;
 
@@ -1719,7 +1726,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 f184750..b1d68a9 100644
--- a/gcc/dwarf2out.c
+++ b/gcc/dwarf2out.c
@@ -1299,6 +1299,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.  */
 
@@ -1324,6 +1325,9 @@ new_loc_descr (enum dwarf_location_atom op, unsigned HOST_WIDE_INT oprnd1,
   dw_loc_descr_ref descr = ggc_cleared_alloc<dw_loc_descr_node> ();
 
   descr->dw_loc_opc = op;
+#if ENABLE_CHECKING
+  descr->dw_loc_frame_offset = -1;
+#endif
   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;
@@ -1426,6 +1430,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 ();
 }
@@ -1740,6 +1751,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);
@@ -2002,6 +2046,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
@@ -2962,6 +3022,12 @@ static GTY(()) unsigned abbrev_die_table_allocated;
 /* Number of elements in abbrev_die_table currently in use.  */
 static GTY(()) unsigned abbrev_die_table_in_use;
 
+/* A hash map to remember the stack usage for DWARF procedures.  The value
+   stored is the stack size difference between before the DWARF procedure
+   invokation and after it returned.  In other words, for a DWARF procedure
+   that consumes N stack slots and that pushes M ones, this stores M - N.  */
+static hash_map<dw_die_ref, int> *dwarf_proc_stack_usage_map;
+
 /* Size (in elements) of increments by which we may expand the
    abbrev_die_table.  */
 #define ABBREV_DIE_TABLE_INCREMENT 256
@@ -3241,6 +3307,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,
@@ -3250,10 +3318,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);
@@ -3271,13 +3342,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);
@@ -3307,10 +3382,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);
@@ -3324,7 +3399,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);
@@ -5457,6 +5532,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
@@ -5575,6 +5659,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;
     }
@@ -7597,6 +7701,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<dw_die_ref, dw_die_ref> &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<dw_die_ref, dw_die_ref> &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<dw_die_ref, dw_die_ref> &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<dw_die_ref, dw_die_ref> &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.  */
 
@@ -7647,6 +7849,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<dw_die_ref, dw_die_ref> copied_dwarf_procs;
+	copy_dwarf_procs_ref_in_dies (c, type_node, copied_dwarf_procs);
+
         if (replacement != NULL)
           c = replacement;
       }
@@ -8249,6 +8458,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 ();
 	}
@@ -8632,6 +8853,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 ();
     }
@@ -8901,6 +9139,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.  */
 
@@ -9179,6 +9428,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 ();
 	}
@@ -11483,6 +11763,151 @@ 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);
+
+  /* Until DWARFv4, 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.  */
 
@@ -14527,6 +14952,67 @@ 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<dw_loc_descr_ref> &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.  */
+  hash_set<dw_loc_descr_ref> 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<void *, free_loc_descr> (NULL);
+}
+
+
+struct dwarf_procedure_info;
 
 /* Helper structure for location descriptions generation.  */
 struct loc_descr_context
@@ -14538,83 +15024,595 @@ 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)
-{
-  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;
+   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:
 
-  /* ??? 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...  */
+   - 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.
 
-  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;
-    }
+   - Then, when returning, the DWARF procedure must have consumed all arguments
+     on the stack, must have pushed the result and touched nothing else.
 
-  switch (TREE_CODE (loc))
-    {
-    case ERROR_MARK:
-      expansion_failed (loc, NULL_RTX, "ERROR_MARK");
-      return 0;
+   - Each integral argument and the result are integral types can be hold in a
+     single stack slot.
 
-    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)
-	    {
-	      ret = new_loc_descr (DW_OP_push_object_address, 0, 0);
-	      have_address = 1;
-	      break;
-	    }
-	  else
-	    return NULL;
-	}
-      else
-	expansion_failed (loc, NULL_RTX,
-			  "PLACEHOLDER_EXPR for an unexpected type");
-      break;
+   - 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.  */
 
-    case CALL_EXPR:
-      expansion_failed (loc, NULL_RTX, "CALL_EXPR");
-      /* There are no opcodes for these operations.  */
-      return 0;
+/* Helper structure used when generating operations for a DWARF procedure.  */
+struct dwarf_procedure_info
+{
+  /* The FUNCTION_DECL node corresponding to the DWARF procedure that is
+     currently translated.  */
+  tree fndecl;
+  /* The number of arguments FNDECL takes.  */
+  unsigned args_count;
+};
 
-    case PREINCREMENT_EXPR:
-    case PREDECREMENT_EXPR:
+/* 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.  */
+
+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;
+
+  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);
+}
+
+/* Helper for resolve_args_picking.  Stop when coming across VISITED nodes.  */
+
+static bool
+resolve_args_picking_1 (dw_loc_descr_ref loc, unsigned initial_frame_offset,
+			struct dwarf_procedure_info *dpi,
+			hash_set<dw_loc_descr_ref> &visited)
+{
+  /* 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;)
+    {
+      /* If we already met this node, there is nothing to compute anymore.  */
+      if (visited.add (l))
+	{
+#if ENABLE_CHECKING
+	  /* Make sure that the stack size is consistent wherever the execution
+	     flow comes from.  */
+	  gcc_assert ((unsigned) l->dw_loc_frame_offset == frame_offset_);
+#endif
+	  break;
+	}
+#if ENABLE_CHECKING
+      l->dw_loc_frame_offset = frame_offset_;
+#endif
+
+      /* 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:
+	  {
+	    dw_die_ref dwarf_proc = l->dw_loc_oprnd1.v.val_die_ref.die;
+	    int *stack_usage = dwarf_proc_stack_usage_map->get (dwarf_proc);
+
+	    if (stack_usage == NULL)
+	      return false;
+	    frame_offset += *stack_usage;
+	    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_1 (l->dw_loc_next, frame_offset_, dpi,
+				       visited))
+	    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;
+}
+
+/* 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)
+{
+  hash_set<dw_loc_descr_ref> visited;
+
+  return resolve_args_picking_1 (loc, initial_frame_offset, dpi, visited);
+}
+
+/* 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_descriptor_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)));
+
+  /* The called DWARF procedure consumes one stack slot per argument and
+     returns one stack slot.  */
+  dwarf_proc_stack_usage_map->put (dwarf_proc_die, 1 - dpi.args_count);
+
+  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)
+	    {
+	      ret = new_loc_descr (DW_OP_push_object_address, 0, 0);
+	      have_address = 1;
+	      break;
+	    }
+	  else
+	    return NULL;
+	}
+      else
+	expansion_failed (loc, NULL_RTX,
+			  "PLACEHOLDER_EXPR for an unexpected type");
+      break;
+
+    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)
+	    {
+	      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;
+	  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:
     case POSTINCREMENT_EXPR:
     case POSTDECREMENT_EXPR:
       expansion_failed (loc, NULL_RTX, "PRE/POST INDCREMENT/DECREMENT");
@@ -14636,7 +15634,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)
@@ -14703,10 +15701,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:
@@ -14780,7 +15802,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;
 
@@ -14790,13 +15812,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:
@@ -14815,10 +15840,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)
@@ -14833,7 +15858,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);
@@ -14864,6 +15889,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,
@@ -14905,6 +15932,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;
@@ -14923,8 +15951,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;
 
@@ -14955,11 +15983,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 "<push literal>; 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;
 	}
 
@@ -14967,32 +16033,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;
@@ -15003,8 +16069,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;
 
@@ -15028,7 +16094,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;
 
@@ -15054,10 +16120,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;
 
@@ -15160,6 +16226,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,
@@ -15230,34 +16312,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<tree> (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;
@@ -15267,6 +16406,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);
@@ -15353,12 +16493,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 */
 
-  object_offset_in_bytes
-    = wi::lrshift (object_offset_in_bits, LOG2_BITS_PER_UNIT);
-  return object_offset_in_bytes.to_shwi ();
+  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);
+
+  /* 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;
 }
 \f
 /* The following routines define various Dwarf attributes and any data
@@ -15422,10 +16583,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;
@@ -15475,7 +16640,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 +18106,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 +18230,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 +18247,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 +18260,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 +18287,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 +18328,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 +18539,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 +19036,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 +19555,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 +20420,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 +20482,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
@@ -19988,10 +21232,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;
 
@@ -20007,11 +21252,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);
@@ -20336,12 +21586,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);
@@ -20362,6 +21614,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:  <discr_field> == <integer_cst>
+		 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<dw_discr_list_node> ();
+	      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:
+		   <discr_field> > <integer_cst>
+		   && <discr_field> < <integer_cst>.
+		 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<dw_discr_list_node> ();
+	      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
@@ -20393,12 +22046,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
@@ -20407,8 +22063,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.  */
@@ -20429,7 +22098,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);
       }
 }
 
@@ -20763,7 +22432,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;
     }
 
@@ -20776,8 +22445,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;
     }
 
@@ -21051,7 +22720,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)
@@ -21217,7 +22886,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;
 
@@ -21330,7 +22999,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);
     }
@@ -21390,10 +23059,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;
@@ -21564,6 +23237,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
@@ -21571,7 +23245,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;
 
@@ -21971,7 +23645,7 @@ dwarf2out_decl (tree decl)
       return;
     }
 
-  gen_decl_die (decl, NULL, context_die);
+  gen_decl_die (decl, NULL, NULL, context_die);
 
   if (flag_checking)
     {
@@ -23283,6 +24957,9 @@ dwarf2out_init (const char *filename ATTRIBUTE_UNUSED)
   /* Zero-th entry is allocated, but unused.  */
   abbrev_die_table_in_use = 1;
 
+  /* Allocate the dwarf_proc_stack_usage_map.  */
+  dwarf_proc_stack_usage_map = new hash_map<dw_die_ref, int>;
+
   /* Allocate the pubtypes and pubnames vectors.  */
   vec_alloc (pubname_table, 32);
   vec_alloc (pubtype_table, 32);
@@ -23592,6 +25269,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.  */
 
@@ -23603,19 +25299,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;
     }
 }
 
@@ -23766,7 +25481,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:
@@ -23774,10 +25488,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:
@@ -25664,6 +27384,8 @@ dwarf2out_c_finalize (void)
   abbrev_die_table = NULL;
   abbrev_die_table_allocated = 0;
   abbrev_die_table_in_use = 0;
+  delete dwarf_proc_stack_usage_map;
+  dwarf_proc_stack_usage_map = NULL;
   line_info_label_num = 0;
   cur_line_info_table = NULL;
   text_section_line_info = NULL;
diff --git a/gcc/dwarf2out.h b/gcc/dwarf2out.h
index 4fe3527..4303e60 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,35 @@ 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;
+#if ENABLE_CHECKING
+  /* 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;
+#endif
   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 b2e4f71..8c8a279 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 fac3895..2470814 100644
--- a/gcc/stor-layout.c
+++ b/gcc/stor-layout.c
@@ -286,13 +286,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.3.3.199.g52cae64


^ permalink raw reply	[flat|nested] 53+ messages in thread

* [PATCHES, PING] Enhance standard DWARF for Ada
  2015-11-26 12:37                       ` Pierre-Marie de Rodat
@ 2015-12-03 10:35                         ` Pierre-Marie de Rodat
  2015-12-10  7:18                           ` [PATCHES, PING*2] " Pierre-Marie de Rodat
  2015-12-11 20:25                         ` [PATCHES, PING*5] " Jason Merrill
  1 sibling, 1 reply; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-12-03 10:35 UTC (permalink / raw)
  To: Jason Merrill, gcc-patches; +Cc: Cary Coutant, Eric Botcazou

On 11/26/2015 01:34 PM, Pierre-Marie de Rodat wrote:
> Done! (I repalced the dwarf_proc_decl_table hash table with a
> dwarf_proc_stack_usage_map hash_map) Here's an update for the only
> affected patch. Regtested again on x86_64-linux.

Ping for the patches submitted in 
<https://gcc.gnu.org/ml/gcc-patches/2015-11/msg02723.html> and for the 
2/8 update submitted in 
<https://gcc.gnu.org/ml/gcc-patches/2015-11/msg03224.html>.

Thank you in advance!

-- 
Pierre-Marie de Rodat

^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*2] Enhance standard DWARF for Ada
  2015-12-03 10:35                         ` [PATCHES, PING] " Pierre-Marie de Rodat
@ 2015-12-10  7:18                           ` Pierre-Marie de Rodat
  0 siblings, 0 replies; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-12-10  7:18 UTC (permalink / raw)
  To: Jason Merrill, gcc-patches; +Cc: Cary Coutant, Eric Botcazou

Ping for the patches submitted in 
<https://gcc.gnu.org/ml/gcc-patches/2015-11/msg02723.html> and for the 
2/8 update submitted in 
<https://gcc.gnu.org/ml/gcc-patches/2015-11/msg03224.html>.

Thank you in advance!

-- 
Pierre-Marie de Rodat

^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*5] Enhance standard DWARF for Ada
  2015-11-26 12:37                       ` Pierre-Marie de Rodat
  2015-12-03 10:35                         ` [PATCHES, PING] " Pierre-Marie de Rodat
@ 2015-12-11 20:25                         ` Jason Merrill
  2015-12-16  8:53                           ` Pierre-Marie de Rodat
  1 sibling, 1 reply; 53+ messages in thread
From: Jason Merrill @ 2015-12-11 20:25 UTC (permalink / raw)
  To: Pierre-Marie de Rodat, gcc-patches; +Cc: Cary Coutant, Eric Botcazou

On 11/26/2015 07:34 AM, Pierre-Marie de Rodat wrote:
> On 11/25/2015 07:35 PM, Jason Merrill wrote:
>>>> Actually, even though my patches introduce DWARF procedures for only
>>>> one
>>> case (size functions from stor-layout.c), they don’t necessarily come
>>> from code generation (GENERIC): they are just a way to factorize common
>>> DWARF operations. Thinking more about it, it may be more sound to store
>>> stack slot diffs instead of FUNCTION_DECL nodes in
>>> dwarf_proc_decl_table.
>>
>> Makes sense.
>
> Done! (I repalced the dwarf_proc_decl_table hash table with a
> dwarf_proc_stack_usage_map hash_map) Here's an update for the only
> affected patch. Regtested again on x86_64-linux.

Hmm, can we generate the DWARF procedures during finalize_size_functions 
to avoid the need for preserve_body?

Jason

^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*5] Enhance standard DWARF for Ada
  2015-12-11 20:25                         ` [PATCHES, PING*5] " Jason Merrill
@ 2015-12-16  8:53                           ` Pierre-Marie de Rodat
  2015-12-16 21:30                             ` Jason Merrill
  2016-02-25  9:48                             ` Jakub Jelinek
  0 siblings, 2 replies; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-12-16  8:53 UTC (permalink / raw)
  To: Jason Merrill, gcc-patches; +Cc: Cary Coutant, Eric Botcazou

[-- Attachment #1: Type: text/plain, Size: 296 bytes --]

On 12/11/2015 09:25 PM, Jason Merrill wrote:
> Hmm, can we generate the DWARF procedures during finalize_size_functions
> to avoid the need for preserve_body?

Good idea, thank you! Here’s the updated patch (bootstrapped and 
regtested on x86_64-linux, as usual).

-- 
Pierre-Marie de Rodat

[-- Attachment #2: 0002-DWARF-handle-variable-length-records-and-variant-par.patch --]
[-- Type: text/x-diff, Size: 114736 bytes --]

From 38576de649614743646bb052f5570dc1973a804a Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
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:

	* debug.h (struct gcc_debug_hooks): Add a new function_body
	hook.
	* debug.c (do_nothing_debug_hooks): Set the function_body field
	to no-op.
	* dbxout.c (dbx_debug_hooks, xcoff_debug_hooks): Likewise.
	* sdbout.c (sdb_debug_hooks): Likewise.
	* vmsdbgout.c (vmsdbg_debug_hooks): Likewise.
	* stor-layout.c (finalize_size_functions): Let the debug info
	back-end know about the implementation of size functions.
	* 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 and
	dw_loc_frame_offset (only for checking) fields to handle DWARF
	procedures generation.
	(struct dw_discr_list_node): New structure.
	* dwarf2out.c (dwarf2out_function_body): New.
	(dwarf2_debug_hooks): Set the function_body field to
	dwarf2out_function_body.
	(dwarf2_lineno_debug_hooks): Set the function_body field to
	no-op.
	(new_loc_descr): Initialize the
	dw_loc_frame_offset field.
	(dwarf_proc_stack_usage_map): New.
	(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_1): 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.
	(dwarf2out_init): Allocate dwarf_proc_stack_usage_map.
	(dwarf2out_c_finalize): Deallocate and reset
	dwarf_proc_stack_usage_map.

gcc/testsuite/ChangeLog:

	* gnat.dg/specs/debug1.ads: Update the expected number of
	DW_AT_artificial attribute in compiler output.

fix
---
 gcc/ada/gcc-interface/decl.c           |   19 +-
 gcc/ada/gcc-interface/utils.c          |    8 +-
 gcc/dbxout.c                           |    2 +
 gcc/debug.c                            |    1 +
 gcc/debug.h                            |    5 +
 gcc/dwarf2out.c                        | 2079 +++++++++++++++++++++++++++++---
 gcc/dwarf2out.h                        |   50 +-
 gcc/sdbout.c                           |    1 +
 gcc/stor-layout.c                      |    5 +
 gcc/testsuite/gnat.dg/specs/debug1.ads |    2 +-
 gcc/vmsdbgout.c                        |    1 +
 11 files changed, 1988 insertions(+), 185 deletions(-)

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index c72e920..4db1193 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -3556,10 +3556,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
@@ -7029,6 +7030,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;
@@ -7211,7 +7214,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);
@@ -7301,7 +7304,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,
@@ -7334,7 +7337,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
@@ -7348,7 +7351,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 23015f3..830a0b8 100644
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -1348,8 +1348,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
@@ -1890,7 +1892,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/dbxout.c b/gcc/dbxout.c
index 1b4a5ea..3f5dbb4 100644
--- a/gcc/dbxout.c
+++ b/gcc/dbxout.c
@@ -375,6 +375,7 @@ const struct gcc_debug_hooks dbx_debug_hooks =
   debug_nothing_rtx_code_label,	         /* label */
   dbxout_handle_pch,		         /* handle_pch */
   debug_nothing_rtx_insn,	         /* var_location */
+  debug_nothing_tree,			 /* function_body */
   debug_nothing_void,                    /* switch_text_section */
   debug_nothing_tree_tree,		 /* set_name */
   0,                                     /* start_end_main_source_file */
@@ -414,6 +415,7 @@ const struct gcc_debug_hooks xcoff_debug_hooks =
   debug_nothing_rtx_code_label,	         /* label */
   dbxout_handle_pch,		         /* handle_pch */
   debug_nothing_rtx_insn,	         /* var_location */
+  debug_nothing_tree,			 /* function_body */
   debug_nothing_void,                    /* switch_text_section */
   debug_nothing_tree_tree,	         /* set_name */
   0,                                     /* start_end_main_source_file */
diff --git a/gcc/debug.c b/gcc/debug.c
index e89529d..829d11e 100644
--- a/gcc/debug.c
+++ b/gcc/debug.c
@@ -53,6 +53,7 @@ const struct gcc_debug_hooks do_nothing_debug_hooks =
   debug_nothing_rtx_code_label,	         /* label */
   debug_nothing_int,		         /* handle_pch */
   debug_nothing_rtx_insn,	         /* var_location */
+  debug_nothing_tree,			 /* function_body */
   debug_nothing_void,                    /* switch_text_section */
   debug_nothing_tree_tree,		 /* set_name */
   0,                                     /* start_end_main_source_file */
diff --git a/gcc/debug.h b/gcc/debug.h
index 9784300..a831d33 100644
--- a/gcc/debug.h
+++ b/gcc/debug.h
@@ -166,6 +166,11 @@ struct gcc_debug_hooks
   /* Called from final_scan_insn for any NOTE_INSN_VAR_LOCATION note.  */
   void (* var_location) (rtx_insn *);
 
+  /* Called from finalize_size_functions for functions whose body is needed to
+     generate complete debug info.  For instance, functions used to compute the
+     size of variable-length structures.  */
+  void (* function_body) (tree decl);
+
   /* Called from final_scan_insn if there is a switch between hot and cold
      text sections.  */
   void (* switch_text_section) (void);
diff --git a/gcc/dwarf2out.c b/gcc/dwarf2out.c
index fe5cab5..51ca35e 100644
--- a/gcc/dwarf2out.c
+++ b/gcc/dwarf2out.c
@@ -1299,6 +1299,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.  */
 
@@ -1324,6 +1325,9 @@ new_loc_descr (enum dwarf_location_atom op, unsigned HOST_WIDE_INT oprnd1,
   dw_loc_descr_ref descr = ggc_cleared_alloc<dw_loc_descr_node> ();
 
   descr->dw_loc_opc = op;
+#if ENABLE_CHECKING
+  descr->dw_loc_frame_offset = -1;
+#endif
   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;
@@ -1426,6 +1430,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 ();
 }
@@ -1740,6 +1751,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);
@@ -2002,6 +2046,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
@@ -2441,6 +2501,7 @@ static void dwarf2out_imported_module_or_decl_1 (tree, tree, tree,
 						 dw_die_ref);
 static void dwarf2out_abstract_function (tree);
 static void dwarf2out_var_location (rtx_insn *);
+static void dwarf2out_function_body (tree);
 static void dwarf2out_begin_function (tree);
 static void dwarf2out_end_function (unsigned int);
 static void dwarf2out_register_main_translation_unit (tree unit);
@@ -2487,6 +2548,7 @@ const struct gcc_debug_hooks dwarf2_debug_hooks =
   debug_nothing_rtx_code_label,	/* label */
   debug_nothing_int,		/* handle_pch */
   dwarf2out_var_location,
+  dwarf2out_function_body,	/* function_body */
   dwarf2out_switch_text_section,
   dwarf2out_set_name,
   1,                            /* start_end_main_source_file */
@@ -2524,6 +2586,7 @@ const struct gcc_debug_hooks dwarf2_lineno_debug_hooks =
   debug_nothing_rtx_code_label,	         /* label */
   debug_nothing_int,		         /* handle_pch */
   debug_nothing_rtx_insn,	         /* var_location */
+  debug_nothing_tree,			 /* var_location */
   debug_nothing_void,                    /* switch_text_section */
   debug_nothing_tree_tree,		 /* set_name */
   0,                                     /* start_end_main_source_file */
@@ -2962,6 +3025,12 @@ static GTY(()) unsigned abbrev_die_table_allocated;
 /* Number of elements in abbrev_die_table currently in use.  */
 static GTY(()) unsigned abbrev_die_table_in_use;
 
+/* A hash map to remember the stack usage for DWARF procedures.  The value
+   stored is the stack size difference between before the DWARF procedure
+   invokation and after it returned.  In other words, for a DWARF procedure
+   that consumes N stack slots and that pushes M ones, this stores M - N.  */
+static hash_map<dw_die_ref, int> *dwarf_proc_stack_usage_map;
+
 /* Size (in elements) of increments by which we may expand the
    abbrev_die_table.  */
 #define ABBREV_DIE_TABLE_INCREMENT 256
@@ -3241,6 +3310,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,
@@ -3250,10 +3321,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);
@@ -3271,13 +3345,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);
@@ -3307,10 +3385,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);
@@ -3323,7 +3401,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);
@@ -5456,6 +5534,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
@@ -5574,6 +5661,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;
     }
@@ -7596,6 +7703,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<dw_die_ref, dw_die_ref> &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<dw_die_ref, dw_die_ref> &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<dw_die_ref, dw_die_ref> &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<dw_die_ref, dw_die_ref> &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.  */
 
@@ -7646,6 +7851,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<dw_die_ref, dw_die_ref> copied_dwarf_procs;
+	copy_dwarf_procs_ref_in_dies (c, type_node, copied_dwarf_procs);
+
         if (replacement != NULL)
           c = replacement;
       }
@@ -8248,6 +8460,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 ();
 	}
@@ -8631,6 +8855,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 ();
     }
@@ -8900,6 +9141,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.  */
 
@@ -9178,6 +9430,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 ();
 	}
@@ -11482,6 +11765,151 @@ 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);
+
+  /* Until DWARFv4, 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.  */
 
@@ -14526,6 +14954,67 @@ 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<dw_loc_descr_ref> &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.  */
+  hash_set<dw_loc_descr_ref> 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<void *, free_loc_descr> (NULL);
+}
+
+
+struct dwarf_procedure_info;
 
 /* Helper structure for location descriptions generation.  */
 struct loc_descr_context
@@ -14537,83 +15026,595 @@ 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)
-{
-  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;
+   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:
 
-  /* ??? 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...  */
+   - 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.
 
-  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;
-    }
+   - Then, when returning, the DWARF procedure must have consumed all arguments
+     on the stack, must have pushed the result and touched nothing else.
 
-  switch (TREE_CODE (loc))
-    {
-    case ERROR_MARK:
-      expansion_failed (loc, NULL_RTX, "ERROR_MARK");
-      return 0;
+   - Each integral argument and the result are integral types can be hold in a
+     single stack slot.
 
-    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)
-	    {
-	      ret = new_loc_descr (DW_OP_push_object_address, 0, 0);
-	      have_address = 1;
-	      break;
-	    }
-	  else
-	    return NULL;
-	}
-      else
-	expansion_failed (loc, NULL_RTX,
-			  "PLACEHOLDER_EXPR for an unexpected type");
-      break;
+   - 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.  */
 
-    case CALL_EXPR:
-      expansion_failed (loc, NULL_RTX, "CALL_EXPR");
-      /* There are no opcodes for these operations.  */
-      return 0;
+/* Helper structure used when generating operations for a DWARF procedure.  */
+struct dwarf_procedure_info
+{
+  /* The FUNCTION_DECL node corresponding to the DWARF procedure that is
+     currently translated.  */
+  tree fndecl;
+  /* The number of arguments FNDECL takes.  */
+  unsigned args_count;
+};
 
-    case PREINCREMENT_EXPR:
-    case PREDECREMENT_EXPR:
+/* 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.  */
+
+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;
+
+  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);
+}
+
+/* Helper for resolve_args_picking.  Stop when coming across VISITED nodes.  */
+
+static bool
+resolve_args_picking_1 (dw_loc_descr_ref loc, unsigned initial_frame_offset,
+			struct dwarf_procedure_info *dpi,
+			hash_set<dw_loc_descr_ref> &visited)
+{
+  /* 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;)
+    {
+      /* If we already met this node, there is nothing to compute anymore.  */
+      if (visited.add (l))
+	{
+#if ENABLE_CHECKING
+	  /* Make sure that the stack size is consistent wherever the execution
+	     flow comes from.  */
+	  gcc_assert ((unsigned) l->dw_loc_frame_offset == frame_offset_);
+#endif
+	  break;
+	}
+#if ENABLE_CHECKING
+      l->dw_loc_frame_offset = frame_offset_;
+#endif
+
+      /* 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:
+	  {
+	    dw_die_ref dwarf_proc = l->dw_loc_oprnd1.v.val_die_ref.die;
+	    int *stack_usage = dwarf_proc_stack_usage_map->get (dwarf_proc);
+
+	    if (stack_usage == NULL)
+	      return false;
+	    frame_offset += *stack_usage;
+	    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_1 (l->dw_loc_next, frame_offset_, dpi,
+				       visited))
+	    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;
+}
+
+/* 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)
+{
+  hash_set<dw_loc_descr_ref> visited;
+
+  return resolve_args_picking_1 (loc, initial_frame_offset, dpi, visited);
+}
+
+/* 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_descriptor_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)));
+
+  /* The called DWARF procedure consumes one stack slot per argument and
+     returns one stack slot.  */
+  dwarf_proc_stack_usage_map->put (dwarf_proc_die, 1 - dpi.args_count);
+
+  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)
+	    {
+	      ret = new_loc_descr (DW_OP_push_object_address, 0, 0);
+	      have_address = 1;
+	      break;
+	    }
+	  else
+	    return NULL;
+	}
+      else
+	expansion_failed (loc, NULL_RTX,
+			  "PLACEHOLDER_EXPR for an unexpected type");
+      break;
+
+    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)
+	    {
+	      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;
+	  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:
     case POSTINCREMENT_EXPR:
     case POSTDECREMENT_EXPR:
       expansion_failed (loc, NULL_RTX, "PRE/POST INDCREMENT/DECREMENT");
@@ -14635,7 +15636,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)
@@ -14702,10 +15703,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:
@@ -14779,7 +15804,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;
 
@@ -14789,13 +15814,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:
@@ -14814,10 +15842,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)
@@ -14832,7 +15860,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);
@@ -14863,6 +15891,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,
@@ -14904,6 +15934,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;
@@ -14922,8 +15953,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;
 
@@ -14954,11 +15985,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 "<push literal>; 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;
 	}
 
@@ -14966,32 +16035,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;
@@ -15002,8 +16071,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;
 
@@ -15027,7 +16096,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;
 
@@ -15053,10 +16122,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;
 
@@ -15159,6 +16228,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,
@@ -15229,34 +16314,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<tree> (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;
@@ -15266,6 +16408,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);
@@ -15352,12 +16495,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;
 }
 \f
 /* The following routines define various Dwarf attributes and any data
@@ -15421,10 +16585,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;
@@ -15474,7 +16642,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)
     {
@@ -16924,6 +18108,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
@@ -17040,6 +18232,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))
     {
@@ -17056,7 +18249,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
@@ -17069,10 +18262,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);
 }
@@ -17089,22 +18289,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
@@ -17126,7 +18330,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
@@ -17336,6 +18541,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 */
 
@@ -17795,7 +19038,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));
@@ -18314,8 +19557,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
@@ -19189,7 +20436,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
@@ -19251,7 +20498,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
@@ -20008,10 +21255,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;
 
@@ -20027,11 +21275,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);
@@ -20356,12 +21609,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);
@@ -20382,6 +21637,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:  <discr_field> == <integer_cst>
+		 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<dw_discr_list_node> ();
+	      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:
+		   <discr_field> > <integer_cst>
+		   && <discr_field> < <integer_cst>.
+		 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<dw_discr_list_node> ();
+	      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
@@ -20413,12 +22069,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
@@ -20427,8 +22086,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.  */
@@ -20449,7 +22121,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);
       }
 }
 
@@ -20783,7 +22455,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;
     }
 
@@ -20796,8 +22468,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;
     }
 
@@ -21072,7 +22744,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)
@@ -21238,7 +22910,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;
 
@@ -21351,7 +23023,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);
     }
@@ -21411,10 +23083,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;
@@ -21585,6 +23261,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
@@ -21592,7 +23269,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;
 
@@ -21996,7 +23673,7 @@ dwarf2out_decl (tree decl)
       return;
     }
 
-  gen_decl_die (decl, NULL, context_die);
+  gen_decl_die (decl, NULL, NULL, context_die);
 
   if (flag_checking)
     {
@@ -22530,6 +24207,16 @@ create_label:
   last_in_cold_section_p = in_cold_section_p;
 }
 
+/* Called from finalize_size_functions for functions whose body is needed to
+   generate complete debug info.  For instance, functions used to compute the
+   size of variable-length structures.  */
+
+static void
+dwarf2out_function_body (tree decl)
+{
+  function_to_dwarf_procedure (decl);
+}
+
 /* Note in one location list that text section has changed.  */
 
 int
@@ -23356,6 +25043,9 @@ dwarf2out_init (const char *filename ATTRIBUTE_UNUSED)
   /* Zero-th entry is allocated, but unused.  */
   abbrev_die_table_in_use = 1;
 
+  /* Allocate the dwarf_proc_stack_usage_map.  */
+  dwarf_proc_stack_usage_map = new hash_map<dw_die_ref, int>;
+
   /* Allocate the pubtypes and pubnames vectors.  */
   vec_alloc (pubname_table, 32);
   vec_alloc (pubtype_table, 32);
@@ -23665,6 +25355,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.  */
 
@@ -23676,19 +25385,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;
     }
 }
 
@@ -23839,7 +25567,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:
@@ -23847,10 +25574,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:
@@ -25737,6 +27470,8 @@ dwarf2out_c_finalize (void)
   abbrev_die_table = NULL;
   abbrev_die_table_allocated = 0;
   abbrev_die_table_in_use = 0;
+  delete dwarf_proc_stack_usage_map;
+  dwarf_proc_stack_usage_map = NULL;
   line_info_label_num = 0;
   cur_line_info_table = NULL;
   text_section_line_info = NULL;
diff --git a/gcc/dwarf2out.h b/gcc/dwarf2out.h
index 4fe3527..4303e60 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,35 @@ 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;
+#if ENABLE_CHECKING
+  /* 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;
+#endif
   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/sdbout.c b/gcc/sdbout.c
index 09fa06e..bb7ea65 100644
--- a/gcc/sdbout.c
+++ b/gcc/sdbout.c
@@ -304,6 +304,7 @@ const struct gcc_debug_hooks sdb_debug_hooks =
   sdbout_label,			         /* label */
   debug_nothing_int,		         /* handle_pch */
   debug_nothing_rtx_insn,	         /* var_location */
+  debug_nothing_tree,			 /* function_body */
   debug_nothing_void,                    /* switch_text_section */
   debug_nothing_tree_tree,		 /* set_name */
   0,                                     /* start_end_main_source_file */
diff --git a/gcc/stor-layout.c b/gcc/stor-layout.c
index fac3895..6aa2c562 100644
--- a/gcc/stor-layout.c
+++ b/gcc/stor-layout.c
@@ -39,6 +39,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "tree-inline.h"
 #include "tree-dump.h"
 #include "gimplify.h"
+#include "debug.h"
 
 /* Data type for the expressions representing sizes of data types.
    It is the first integer type laid out.  */
@@ -292,6 +293,10 @@ finalize_size_functions (void)
       allocate_struct_function (fndecl, false);
       set_cfun (NULL);
       dump_function (TDI_original, fndecl);
+
+      /* As these functions are used to describe the layout of variable-length
+         structures, debug info generation needs their implementation.  */
+      debug_hooks->function_body (fndecl);
       gimplify_function_tree (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 } }
diff --git a/gcc/vmsdbgout.c b/gcc/vmsdbgout.c
index d41d4b2..903a641 100644
--- a/gcc/vmsdbgout.c
+++ b/gcc/vmsdbgout.c
@@ -201,6 +201,7 @@ const struct gcc_debug_hooks vmsdbg_debug_hooks
    debug_nothing_rtx_code_label,  /* label */
    debug_nothing_int,		  /* handle_pch */
    debug_nothing_rtx_insn,	  /* var_location */
+   debug_nothing_tree,		  /* function_body */
    debug_nothing_void,            /* switch_text_section */
    debug_nothing_tree_tree,	  /* set_name */
    0,                             /* start_end_main_source_file */
-- 
2.3.3.199.g52cae64


^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*5] Enhance standard DWARF for Ada
  2015-12-16  8:53                           ` Pierre-Marie de Rodat
@ 2015-12-16 21:30                             ` Jason Merrill
  2015-12-17 14:10                               ` Pierre-Marie de Rodat
  2016-02-25  9:48                             ` Jakub Jelinek
  1 sibling, 1 reply; 53+ messages in thread
From: Jason Merrill @ 2015-12-16 21:30 UTC (permalink / raw)
  To: Pierre-Marie de Rodat, gcc-patches; +Cc: Cary Coutant, Eric Botcazou

On 12/16/2015 03:53 AM, Pierre-Marie de Rodat wrote:
> +  /* Called from finalize_size_functions for functions whose body is needed to
> +     generate complete debug info.  For instance, functions used to compute the
> +     size of variable-length structures.  */
> +  void (* function_body) (tree decl);

Calling this "function_body" seems overly generic; let's call it 
size_function and talk specifically about encoding the function body in 
the debug info.

>    debug_nothing_rtx_insn,	         /* var_location */
> +  debug_nothing_tree,			 /* var_location */

And this comment shouldn't be the same as the previous line.

> +/* 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)

Blank line between comment and function.

OK with those changes.

Jason

^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*5] Enhance standard DWARF for Ada
  2015-12-16 21:30                             ` Jason Merrill
@ 2015-12-17 14:10                               ` Pierre-Marie de Rodat
  2015-12-18 17:56                                 ` Jason Merrill
  0 siblings, 1 reply; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-12-17 14:10 UTC (permalink / raw)
  To: Jason Merrill, gcc-patches; +Cc: Cary Coutant, Eric Botcazou

On 12/16/2015 10:30 PM, Jason Merrill wrote:
> OK with those changes.

All changes done, and all patches pushed. Thank you very much!!

-- 
Pierre-Marie de Rodat

^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*5] Enhance standard DWARF for Ada
  2015-12-17 14:10                               ` Pierre-Marie de Rodat
@ 2015-12-18 17:56                                 ` Jason Merrill
  2015-12-18 17:58                                   ` Jakub Jelinek
  2015-12-18 20:23                                   ` Pierre-Marie de Rodat
  0 siblings, 2 replies; 53+ messages in thread
From: Jason Merrill @ 2015-12-18 17:56 UTC (permalink / raw)
  To: Pierre-Marie de Rodat, gcc-patches; +Cc: Cary Coutant, Eric Botcazou

On 12/17/2015 09:10 AM, Pierre-Marie de Rodat wrote:
> On 12/16/2015 10:30 PM, Jason Merrill wrote:
>> OK with those changes.
>
> All changes done, and all patches pushed. Thank you very much!!

These broke a lot of tests in the GDB C++ testsuite.  Specifically, the 
commit

     DWARF: handle variable-length records and variant parts

Jason

^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*5] Enhance standard DWARF for Ada
  2015-12-18 17:56                                 ` Jason Merrill
@ 2015-12-18 17:58                                   ` Jakub Jelinek
  2015-12-18 18:22                                     ` Eric Botcazou
  2015-12-18 20:23                                   ` Pierre-Marie de Rodat
  1 sibling, 1 reply; 53+ messages in thread
From: Jakub Jelinek @ 2015-12-18 17:58 UTC (permalink / raw)
  To: Jason Merrill
  Cc: Pierre-Marie de Rodat, gcc-patches, Cary Coutant, Eric Botcazou

On Fri, Dec 18, 2015 at 12:56:07PM -0500, Jason Merrill wrote:
> On 12/17/2015 09:10 AM, Pierre-Marie de Rodat wrote:
> >On 12/16/2015 10:30 PM, Jason Merrill wrote:
> >>OK with those changes.
> >
> >All changes done, and all patches pushed. Thank you very much!!
> 
> These broke a lot of tests in the GDB C++ testsuite.  Specifically, the
> commit
> 
>     DWARF: handle variable-length records and variant parts

I'm also seeing
+FAIL: gnat.dg/specs/debug1.ads scan-assembler-times DW_AT_artificial 17
and from what I can see in gcc-testresults, I'm not alone.

	Jakub

^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*5] Enhance standard DWARF for Ada
  2015-12-18 17:58                                   ` Jakub Jelinek
@ 2015-12-18 18:22                                     ` Eric Botcazou
  2016-01-02 21:37                                       ` Andreas Schwab
  0 siblings, 1 reply; 53+ messages in thread
From: Eric Botcazou @ 2015-12-18 18:22 UTC (permalink / raw)
  To: Jakub Jelinek
  Cc: gcc-patches, Jason Merrill, Pierre-Marie de Rodat, Cary Coutant

[-- Attachment #1: Type: text/plain, Size: 263 bytes --]

> I'm also seeing
> +FAIL: gnat.dg/specs/debug1.ads scan-assembler-times DW_AT_artificial 17
> and from what I can see in gcc-testresults, I'm not alone.

Minor oversight, adjusted like so:

	* gnat.dg/specs/debug1.ads: Bump final count to 18.

-- 
Eric Botcazou

[-- Attachment #2: p.diff --]
[-- Type: text/x-patch, Size: 372 bytes --]

Index: gnat.dg/specs/debug1.ads
===================================================================
--- gnat.dg/specs/debug1.ads	(revision 231814)
+++ gnat.dg/specs/debug1.ads	(working copy)
@@ -11,4 +11,4 @@ package Debug1 is
 
 end Debug1;
 
--- { dg-final { scan-assembler-times "DW_AT_artificial" 17 } }
+-- { dg-final { scan-assembler-times "DW_AT_artificial" 18 } }

^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*5] Enhance standard DWARF for Ada
  2015-12-18 17:56                                 ` Jason Merrill
  2015-12-18 17:58                                   ` Jakub Jelinek
@ 2015-12-18 20:23                                   ` Pierre-Marie de Rodat
  2015-12-21 14:16                                     ` Pierre-Marie de Rodat
  1 sibling, 1 reply; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-12-18 20:23 UTC (permalink / raw)
  To: Jason Merrill, gcc-patches; +Cc: Cary Coutant, Eric Botcazou

On 12/18/2015 06:56 PM, Jason Merrill wrote:
> These broke a lot of tests in the GDB C++ testsuite.  Specifically, the
> commit
>
>      DWARF: handle variable-length records and variant parts

Arg, sad to hear that! I did testing at some point with the GDB 
testsuiteÂ… IÂ’ll investigate on Monday, thank you for the heads up.

-- 
Pierre-Marie de Rodat

^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*5] Enhance standard DWARF for Ada
  2015-12-18 20:23                                   ` Pierre-Marie de Rodat
@ 2015-12-21 14:16                                     ` Pierre-Marie de Rodat
  2015-12-21 15:40                                       ` Jason Merrill
  0 siblings, 1 reply; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-12-21 14:16 UTC (permalink / raw)
  To: Jason Merrill, gcc-patches; +Cc: Cary Coutant, Eric Botcazou

[-- Attachment #1: Type: text/plain, Size: 966 bytes --]

On 12/18/2015 09:23 PM, Pierre-Marie de Rodat wrote:
> On 12/18/2015 06:56 PM, Jason Merrill wrote:
>> These broke a lot of tests in the GDB C++ testsuite.  Specifically, the
>> commit
>>
>>      DWARF: handle variable-length records and variant parts
>
> Arg, sad to hear that! I did testing at some point with the GDB
> testsuite… I’ll investigate on Monday, thank you for the heads up.

All the regressions I could reproduce have a single cause: an oversight 
in protective code. That patch tries to disable dynamic data member 
offset generation by default because GDB does not handle it very well 
right now. But it should not disable this for DW_TAG_inheritance, in 
which dynamic data member offset *is* supported by GDB.

The attached patch fixes this oversight. Bootstrapped and regtested on 
x86_64-linux; I also made sure it fixed the GDB regressions on the same 
platform (for Ada, C, C++ and Fortran). Ok to commit?

-- 
Pierre-Marie de Rodat

[-- Attachment #2: 0001-DWARF-allow-dynamic-data-member-offsets-for-inherita.patch --]
[-- Type: text/x-diff, Size: 2116 bytes --]

From bd4bd565391a54f40c9f882c2df91ec48e841c99 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Mon, 21 Dec 2015 15:04:59 +0100
Subject: [PATCH] DWARF: allow dynamic data member offsets for inheritance info

An unintended effect of the recently introduced machinery to handle
dynamic data member offsets in variable-length records (when
-fgnat-encodings=minimal) prevented GCC from describing correctly
inheritance information for classes in C++, which is a regression.

This change rectifies this machinery in this case.

gcc/ChangeLog:

	* dwarf2out.c (add_data_member_location_attribute): Do not
	disable dynamic data member offsets descriptions for TREE_BINFO
	members.
---
 gcc/dwarf2out.c | 22 +++++++++++-----------
 1 file changed, 11 insertions(+), 11 deletions(-)

diff --git a/gcc/dwarf2out.c b/gcc/dwarf2out.c
index 320a077..0a5cc54 100644
--- a/gcc/dwarf2out.c
+++ b/gcc/dwarf2out.c
@@ -16727,21 +16727,21 @@ add_data_member_location_attribute (dw_die_ref die,
     {
       loc_descr = field_byte_offset (decl, ctx, &offset);
 
-      /* Data member location evalutation start with the base address on the
+      /* 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;
+	}
+
+      /* Data member location evalutation starts with the base address on the
 	 stack.  Compute the field offset and add it to this base address.  */
-      if (loc_descr != NULL)
+      else 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)
     {
       if (dwarf_version > 2)
-- 
2.3.3.199.g52cae64


^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*5] Enhance standard DWARF for Ada
  2015-12-21 14:16                                     ` Pierre-Marie de Rodat
@ 2015-12-21 15:40                                       ` Jason Merrill
  2015-12-21 15:44                                         ` Pierre-Marie de Rodat
  0 siblings, 1 reply; 53+ messages in thread
From: Jason Merrill @ 2015-12-21 15:40 UTC (permalink / raw)
  To: Pierre-Marie de Rodat, gcc-patches; +Cc: Cary Coutant, Eric Botcazou

OK, thanks.

Jason

^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*5] Enhance standard DWARF for Ada
  2015-12-21 15:40                                       ` Jason Merrill
@ 2015-12-21 15:44                                         ` Pierre-Marie de Rodat
  0 siblings, 0 replies; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2015-12-21 15:44 UTC (permalink / raw)
  To: Jason Merrill, gcc-patches; +Cc: Cary Coutant, Eric Botcazou

On 12/21/2015 04:39 PM, Jason Merrill wrote:
> OK, thanks.

Committed. Thank you again!

-- 
Pierre-Marie de Rodat

^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*5] Enhance standard DWARF for Ada
  2015-12-18 18:22                                     ` Eric Botcazou
@ 2016-01-02 21:37                                       ` Andreas Schwab
  2016-01-02 23:45                                         ` Eric Botcazou
  0 siblings, 1 reply; 53+ messages in thread
From: Andreas Schwab @ 2016-01-02 21:37 UTC (permalink / raw)
  To: Eric Botcazou
  Cc: Jakub Jelinek, gcc-patches, Jason Merrill, Pierre-Marie de Rodat,
	Cary Coutant

Eric Botcazou <ebotcazou@adacore.com> writes:

>> I'm also seeing
>> +FAIL: gnat.dg/specs/debug1.ads scan-assembler-times DW_AT_artificial 17
>> and from what I can see in gcc-testresults, I'm not alone.
>
> Minor oversight, adjusted like so:
>
> 	* gnat.dg/specs/debug1.ads: Bump final count to 18.

On powerpc64:

FAIL: gnat.dg/specs/debug1.ads scan-assembler-times DW_AT_artificial 18

$ grep -c DW_AT_artificial debug1.s
17

Andreas.

-- 
Andreas Schwab, schwab@linux-m68k.org
GPG Key fingerprint = 58CA 54C7 6D53 942B 1756  01D3 44D5 214B 8276 4ED5
"And now for something completely different."

^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*5] Enhance standard DWARF for Ada
  2016-01-02 21:37                                       ` Andreas Schwab
@ 2016-01-02 23:45                                         ` Eric Botcazou
  2016-01-05  9:02                                           ` Pierre-Marie de Rodat
  0 siblings, 1 reply; 53+ messages in thread
From: Eric Botcazou @ 2016-01-02 23:45 UTC (permalink / raw)
  To: Andreas Schwab
  Cc: gcc-patches, Jakub Jelinek, Jason Merrill, Pierre-Marie de Rodat,
	Cary Coutant

> On powerpc64:
> 
> FAIL: gnat.dg/specs/debug1.ads scan-assembler-times DW_AT_artificial 18
> 
> $ grep -c DW_AT_artificial debug1.s
> 17

Test removed.

-- 
Eric Botcazou

^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*5] Enhance standard DWARF for Ada
  2016-01-02 23:45                                         ` Eric Botcazou
@ 2016-01-05  9:02                                           ` Pierre-Marie de Rodat
  0 siblings, 0 replies; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2016-01-05  9:02 UTC (permalink / raw)
  To: Eric Botcazou, Andreas Schwab
  Cc: gcc-patches, Jakub Jelinek, Jason Merrill, Cary Coutant

On 01/03/2016 12:45 AM, Eric Botcazou wrote:
>> On powerpc64:
>>
>> FAIL: gnat.dg/specs/debug1.ads scan-assembler-times DW_AT_artificial 18
>>
>> $ grep -c DW_AT_artificial debug1.s
>> 17
>
> Test removed.

Thank you both!

-- 
Pierre-Marie de Rodat

^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*5] Enhance standard DWARF for Ada
  2015-12-16  8:53                           ` Pierre-Marie de Rodat
  2015-12-16 21:30                             ` Jason Merrill
@ 2016-02-25  9:48                             ` Jakub Jelinek
  2016-02-25 10:35                               ` Pierre-Marie de Rodat
  2016-02-25 15:54                               ` Pierre-Marie de Rodat
  1 sibling, 2 replies; 53+ messages in thread
From: Jakub Jelinek @ 2016-02-25  9:48 UTC (permalink / raw)
  To: Pierre-Marie de Rodat
  Cc: Jason Merrill, gcc-patches, Cary Coutant, Eric Botcazou

[-- Attachment #1: Type: text/plain, Size: 2550 bytes --]

On Wed, Dec 16, 2015 at 09:53:37AM +0100, Pierre-Marie de Rodat wrote:
> On 12/11/2015 09:25 PM, Jason Merrill wrote:
> >Hmm, can we generate the DWARF procedures during finalize_size_functions
> >to avoid the need for preserve_body?
> 
> Good idea, thank you! Here’s the updated patch (bootstrapped and regtested
> on x86_64-linux, as usual).

Unfortunately, this broke the DW_OP_GNU_implicit_pointer support, on vast
majority of binaries and libraries gcc now emits invalid DWARF (which both
gdb and dwz complain about and dwz refuses to optimize because of that).

I'm attaching two possible patches, so far untested.

The first one just fixes what I mainly care about, the committed patch
assumed that DW_TAG_dwarf_procedure is always only created for the Ada
variable sized structures or whatever it was meant for, which is not the
case, and thus if we emit DW_TAG_dwarf_procedure for some other reason,
it would be pruned as unused even when it is actually used (and result in
a DIE reference to the compilation unit header, which is always invalid).

But, looking at the points where you use DW_TAG_dwarf_procedure for the Ada
things, I can't see how it can actually work at all, though there is no
testsuite coverage, so it is hard to find out for real.
The thing is, current code sets die_perennial_p on type DIEs and their
parents, but nothing else.  In particular, type DIEs are identified by
being returned from lookup_type_die, thus earlier passed to
equate_type_number_to_die.  I don't see that this would ever be the case
of DW_TAG_dwarf_procedure though, I see the return of
function_to_dwarf_procedure being used as dw_loc_oprnd1.v.val_die_ref.die
of a DW_OP_call4 that is somewhere used in some location description that is
perhaps used somewhere in some type DIE computation.
Thus, I'm afraid for Ada variable sized structures you get the same problem,
you might IMHO DW_OP_call4 .Ldebug_info0 + 0 because the
DW_TAG_dwarf_procedure will be pruned as "unused".  So IMHO the second patch
makes more sense, and if you (for GCC 7?) want to prune really unused
DW_TAG_dwarf_procedure, you need to add code that will really walk all of
the debuginfo, rather than just type DIEs themselves, and look if location
descriptions (in .debug_info or .debug_loc) reference those
DW_TAG_dwarf_procedure and mark the DW_TAG_dwarf_procedure.

So, Pierre-Marie, can I ask you to run whatever Ada debug info testsuite
you have with the second patch?  And for GCC 7 really please consider adding
gnat.dg/guality/ and fill it with tests.

	Jakub

[-- Attachment #2: V776a --]
[-- Type: text/plain, Size: 1214 bytes --]

2016-02-25  Jakub Jelinek  <jakub@redhat.com>

	PR debug/69947
	* dwarf2out.c (string_cst_pool_decl): Set die_perennial_p on
	the DW_TAG_dwarf_procedure DIE.

	* gcc.dg/guality/pr69947.c: New test.

--- gcc/dwarf2out.c.jj	2016-02-24 23:03:32.000000000 +0100
+++ gcc/dwarf2out.c	2016-02-25 10:08:46.688716691 +0100
@@ -26288,6 +26288,7 @@ string_cst_pool_decl (tree t)
       l->dw_loc_oprnd2.v.val_vec.elt_size = 1;
       l->dw_loc_oprnd2.v.val_vec.array = array;
       add_AT_loc (ref, DW_AT_location, l);
+      ref->die_perennial_p = 1;
       equate_decl_number_to_die (decl, ref);
     }
   return rtl;
--- gcc/testsuite/gcc.dg/guality/pr69947.c.jj	2016-02-25 10:00:25.503608176 +0100
+++ gcc/testsuite/gcc.dg/guality/pr69947.c	2016-02-25 10:05:20.446552599 +0100
@@ -0,0 +1,22 @@
+/* PR debug/69947 */
+/* { dg-do run } */
+/* { dg-options "-g" } */
+
+#include "../nop.h"
+
+static const char *c = "foobar";
+
+__attribute__((noinline, noclone)) void
+foo (void)
+{
+  static const char a[] = "abcdefg";
+  const char *b = a;		/* { dg-final { gdb-test 14 "c\[2\]" "'o'" } } */
+  asm (NOP : : : "memory");	/* { dg-final { gdb-test 14 "b\[4\]" "'e'" } } */
+}
+
+int
+main ()
+{
+  foo ();
+  return 0;
+}

[-- Attachment #3: V776b --]
[-- Type: text/plain, Size: 1244 bytes --]

2016-02-25  Jakub Jelinek  <jakub@redhat.com>

	PR debug/69947
	* dwarf2out.c (prune_unused_types_walk): Don't prune
	DW_TAG_dwarf_procedure.

	* gcc.dg/guality/pr69947.c: New test.

--- gcc/dwarf2out.c.jj	2016-02-24 23:03:32.000000000 +0100
+++ gcc/dwarf2out.c	2016-02-25 10:08:46.688716691 +0100
@@ -25853,11 +25853,6 @@ prune_unused_types_walk (dw_die_ref die)
     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;
 
--- gcc/testsuite/gcc.dg/guality/pr69947.c.jj	2016-02-25 10:00:25.503608176 +0100
+++ gcc/testsuite/gcc.dg/guality/pr69947.c	2016-02-25 10:05:20.446552599 +0100
@@ -0,0 +1,22 @@
+/* PR debug/69947 */
+/* { dg-do run } */
+/* { dg-options "-g" } */
+
+#include "../nop.h"
+
+static const char *c = "foobar";
+
+__attribute__((noinline, noclone)) void
+foo (void)
+{
+  static const char a[] = "abcdefg";
+  const char *b = a;		/* { dg-final { gdb-test 14 "c\[2\]" "'o'" } } */
+  asm (NOP : : : "memory");	/* { dg-final { gdb-test 14 "b\[4\]" "'e'" } } */
+}
+
+int
+main ()
+{
+  foo ();
+  return 0;
+}

^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*5] Enhance standard DWARF for Ada
  2016-02-25  9:48                             ` Jakub Jelinek
@ 2016-02-25 10:35                               ` Pierre-Marie de Rodat
  2016-02-25 10:45                                 ` Jakub Jelinek
  2016-02-25 15:51                                 ` Jakub Jelinek
  2016-02-25 15:54                               ` Pierre-Marie de Rodat
  1 sibling, 2 replies; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2016-02-25 10:35 UTC (permalink / raw)
  To: Jakub Jelinek; +Cc: Jason Merrill, gcc-patches, Cary Coutant, Eric Botcazou

On 02/25/2016 10:48 AM, Jakub Jelinek wrote:
> Unfortunately, this broke the DW_OP_GNU_implicit_pointer support, on vast
> majority of binaries and libraries gcc now emits invalid DWARF (which both
> gdb and dwz complain about and dwz refuses to optimize because of that).

Arg, sorry about this!

> I'm attaching two possible patches, so far untested.

Thanks, I’m having a look as we speak.

> So, Pierre-Marie, can I ask you to run whatever Ada debug info testsuite
> you have with the second patch?  And for GCC 7 really please consider adding
> gnat.dg/guality/ and fill it with tests.

Testing in progress…

I have a tiny Python/pyelftools-based testsuite that checks the DIE 
patterns GCC emits for several Ada types. I really wish I could somehow 
integrate them to the GCC testsuite, but right now I don’t know how I 
could do similar things, there.

As I said at the end of a message in another thread 
(https://gcc.gnu.org/ml/gcc-patches/2016-01/msg01078.html), I always 
feel uncomfortable writing brittle dg-scan testcases, hence the current 
lack of testcases for those DWARF changes.

-- 
Pierre-Marie de Rodat

^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*5] Enhance standard DWARF for Ada
  2016-02-25 10:35                               ` Pierre-Marie de Rodat
@ 2016-02-25 10:45                                 ` Jakub Jelinek
  2016-02-25 12:23                                   ` Eric Botcazou
  2016-02-25 15:51                                 ` Jakub Jelinek
  1 sibling, 1 reply; 53+ messages in thread
From: Jakub Jelinek @ 2016-02-25 10:45 UTC (permalink / raw)
  To: Pierre-Marie de Rodat
  Cc: Jason Merrill, gcc-patches, Cary Coutant, Eric Botcazou

On Thu, Feb 25, 2016 at 11:35:07AM +0100, Pierre-Marie de Rodat wrote:
> As I said at the end of a message in another thread
> (https://gcc.gnu.org/ml/gcc-patches/2016-01/msg01078.html), I always feel
> uncomfortable writing brittle dg-scan testcases, hence the current lack of
> testcases for those DWARF changes.

I agree that catching this in scan-assembler test is hard, but guality test
would catch this.  It is true that some guality tests (mostly the ones that
test behaviour of optimized code, which differs a lot between different
architectures) have known FAILs (or known XFAILs), because the target,
compilation options and gdb version matrix is too large to catch all cases.
But, if one just looks at test_summary output before/after a change,
one can detect regressions and fix them.  Perhaps in some cases you could
just limit to -O0 guality if it is something you want to just check if
the debug info is represented properly and don't need to test
-fvar-tracking-assignments etc. handling - you can just dg-skip-if the tests
except for -O0 etc.
Similarly, it shouldn't be hard to add tcl function to check for gdb
version, and limit some tests only to a particular version of gdb or newer.

	Jakub

^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*5] Enhance standard DWARF for Ada
  2016-02-25 10:45                                 ` Jakub Jelinek
@ 2016-02-25 12:23                                   ` Eric Botcazou
  0 siblings, 0 replies; 53+ messages in thread
From: Eric Botcazou @ 2016-02-25 12:23 UTC (permalink / raw)
  To: Jakub Jelinek
  Cc: Pierre-Marie de Rodat, Jason Merrill, gcc-patches, Cary Coutant

> I agree that catching this in scan-assembler test is hard, but guality test
> would catch this.  It is true that some guality tests (mostly the ones that
> test behaviour of optimized code, which differs a lot between different
> architectures) have known FAILs (or known XFAILs), because the target,
> compilation options and gdb version matrix is too large to catch all cases.

IMO the guality testsuite is not really appropriate for debug info issues, 
it's too brittle, has a low signal-over-noise ratio and nobody really cares 
about it.  And, given that most people already don't care about the regular 
gnat.dg testsuite, I think that literally nobody will about gnat.dg/guality.

Given that only AdaCore's folks work on Ada debug info issues in practice and 
that they run the GDB testsuite, I don't see any real need for it.

-- 
Eric Botcazou

^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*5] Enhance standard DWARF for Ada
  2016-02-25 10:35                               ` Pierre-Marie de Rodat
  2016-02-25 10:45                                 ` Jakub Jelinek
@ 2016-02-25 15:51                                 ` Jakub Jelinek
  2016-02-25 15:59                                   ` Pierre-Marie de Rodat
  1 sibling, 1 reply; 53+ messages in thread
From: Jakub Jelinek @ 2016-02-25 15:51 UTC (permalink / raw)
  To: Pierre-Marie de Rodat
  Cc: Jason Merrill, gcc-patches, Cary Coutant, Eric Botcazou

On Thu, Feb 25, 2016 at 11:35:07AM +0100, Pierre-Marie de Rodat wrote:
> On 02/25/2016 10:48 AM, Jakub Jelinek wrote:
> >Unfortunately, this broke the DW_OP_GNU_implicit_pointer support, on vast
> >majority of binaries and libraries gcc now emits invalid DWARF (which both
> >gdb and dwz complain about and dwz refuses to optimize because of that).
> 
> Arg, sorry about this!
> 
> >I'm attaching two possible patches, so far untested.
> 
> Thanks, I’m having a look as we speak.
> 
> >So, Pierre-Marie, can I ask you to run whatever Ada debug info testsuite
> >you have with the second patch?  And for GCC 7 really please consider adding
> >gnat.dg/guality/ and fill it with tests.
> 
> Testing in progress…
> 
> I have a tiny Python/pyelftools-based testsuite that checks the DIE patterns
> GCC emits for several Ada types. I really wish I could somehow integrate
> them to the GCC testsuite, but right now I don’t know how I could do similar
> things, there.

Do you have some short Ada testcase where the DW_OP_call4 referring to
DW_TAG_dwarf_procedure is supposed to be emitted?  I believe you must be
getting there the .Ldebug_info0+0 invalid reference in the DW_OP_call4
operand.

	Jakub

^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*5] Enhance standard DWARF for Ada
  2016-02-25  9:48                             ` Jakub Jelinek
  2016-02-25 10:35                               ` Pierre-Marie de Rodat
@ 2016-02-25 15:54                               ` Pierre-Marie de Rodat
  2016-02-25 16:46                                 ` [PATCH] Fix DW_OP_GNU_implicit_pointer referring to DW_TAG_dwarf_procedure (PR debug/69947) Jakub Jelinek
  1 sibling, 1 reply; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2016-02-25 15:54 UTC (permalink / raw)
  To: Jakub Jelinek; +Cc: Jason Merrill, gcc-patches, Cary Coutant, Eric Botcazou

[-- Attachment #1: Type: text/plain, Size: 2686 bytes --]

On 02/25/2016 10:48 AM, Jakub Jelinek wrote:
> The first one just fixes what I mainly care about, the committed patch
> assumed that DW_TAG_dwarf_procedure is always only created for the Ada
> variable sized structures or whatever it was meant for, which is not the
> case, and thus if we emit DW_TAG_dwarf_procedure for some other reason,
> it would be pruned as unused even when it is actually used (and result in
> a DIE reference to the compilation unit header, which is always invalid).

This first patch looks good to me, as a good enough and simple fix.

> But, looking at the points where you use DW_TAG_dwarf_procedure for the Ada
> things, I can't see how it can actually work at all, though there is no
> testsuite coverage, so it is hard to find out for real.
> The thing is, current code sets die_perennial_p on type DIEs and their
> parents, but nothing else.  In particular, type DIEs are identified by
> being returned from lookup_type_die, thus earlier passed to
> equate_type_number_to_die.  I don't see that this would ever be the case
> of DW_TAG_dwarf_procedure though, I see the return of
> function_to_dwarf_procedure being used as dw_loc_oprnd1.v.val_die_ref.die
> of a DW_OP_call4 that is somewhere used in some location description that is
> perhaps used somewhere in some type DIE computation.

I introduced a DW_OP_call* traversal for this:

   * prune_unused_types_mark traverses attributes using
     prune_unused_types_walk_attribs;

   * …_walk_attribs walks location descriptions and location lists using
     …_walk_loc_descr

   * …_walk_loc_descr marks DWARF procedures referenced by DW_OP_call*
     operations.

So all DWARF procedures referenced this way are not supposed to be 
pruned (I checked: no problem for the Ada types I tested). As you 
noticed, I did not realize that there were other DWARF procedure 
producers, hence the assumption that this was enought to mark all DWARF 
procs.

> So IMHO the second patch
> makes more sense, and if you (for GCC 7?) want to prune really unused
> DW_TAG_dwarf_procedure, you need to add code that will really walk all of
> the debuginfo, rather than just type DIEs themselves, and look if location
> descriptions (in .debug_info or .debug_loc) reference those
> DW_TAG_dwarf_procedure and mark the DW_TAG_dwarf_procedure.

I just had a look: the prune_unused_type_mark pass already reaches the 
DW_OP_GNU_implicit_pointer operation, it’s just that 
prune_unused_types_walk_loc_descr does not know about this kind of 
operation. I think the attached patch is a more general fix for that. 
What do you think?

(bootstrapped and regtested on x86_64-linux)

-- 
Pierre-Marie de Rodat

[-- Attachment #2: 0001-DWARF-fix-debug-info-for-implicit-pointers-to-string.patch --]
[-- Type: text/x-diff, Size: 2395 bytes --]

From 671199e8a7da326e54e081b5c368f93428455e98 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Thu, 25 Feb 2016 11:37:22 +0100
Subject: [PATCH] DWARF: fix debug info for implicit pointers to string
 constants

2016-02-25  Pierre-Marie de Rodat  <derodat@adacore.com>

        PR debug/69947
        * dwarf2out.c (prune_unused_types_walk_loc_descr): Recurse on
          all dw_val_class_die_ref operands, not just the ones for
          DW_OP_call* operations.

2016-02-25  Jakub Jelinek  <jakub@redhat.com>

        PR debug/69947
        * gcc.dg/guality/pr69947.c: New test.
---
 gcc/dwarf2out.c                        | 16 +++++++---------
 gcc/testsuite/gcc.dg/guality/pr69947.c | 22 ++++++++++++++++++++++
 2 files changed, 29 insertions(+), 9 deletions(-)
 create mode 100644 gcc/testsuite/gcc.dg/guality/pr69947.c

diff --git a/gcc/dwarf2out.c b/gcc/dwarf2out.c
index 97e192b..37ccd3a 100644
--- a/gcc/dwarf2out.c
+++ b/gcc/dwarf2out.c
@@ -25639,16 +25639,14 @@ 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:
+    {
+      if (loc->dw_loc_oprnd1.val_class == dw_val_class_die_ref
+	  && !loc->dw_loc_oprnd1.v.val_die_ref.external)
 	prune_unused_types_mark (loc->dw_loc_oprnd1.v.val_die_ref.die, 1);
-	break;
-      default:
-	break;
-      }
+      if (loc->dw_loc_oprnd2.val_class == dw_val_class_die_ref
+	  && !loc->dw_loc_oprnd2.v.val_die_ref.external)
+	prune_unused_types_mark (loc->dw_loc_oprnd2.v.val_die_ref.die, 1);
+    }
 }
 
 /* Given DIE that we're marking as used, find any other dies
diff --git a/gcc/testsuite/gcc.dg/guality/pr69947.c b/gcc/testsuite/gcc.dg/guality/pr69947.c
new file mode 100644
index 0000000..6280ed5
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/guality/pr69947.c
@@ -0,0 +1,22 @@
+/* PR debug/69947 */
+/* { dg-do run } */
+/* { dg-options "-g" } */
+
+#include "../nop.h"
+
+static const char *c = "foobar";
+
+__attribute__((noinline, noclone)) void
+foo (void)
+{
+  static const char a[] = "abcdefg";
+  const char *b = a;		/* { dg-final { gdb-test 14 "c\[2\]" "'o'" } } */
+  asm (NOP : : : "memory");	/* { dg-final { gdb-test 14 "b\[4\]" "'e'" } } */
+}
+
+int
+main ()
+{
+  foo ();
+  return 0;
+}
-- 
2.3.3.199.g52cae64


^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCHES, PING*5] Enhance standard DWARF for Ada
  2016-02-25 15:51                                 ` Jakub Jelinek
@ 2016-02-25 15:59                                   ` Pierre-Marie de Rodat
  0 siblings, 0 replies; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2016-02-25 15:59 UTC (permalink / raw)
  To: Jakub Jelinek; +Cc: Jason Merrill, gcc-patches, Cary Coutant, Eric Botcazou

[-- Attachment #1: Type: text/plain, Size: 453 bytes --]

On 02/25/2016 04:51 PM, Jakub Jelinek wrote:
> Do you have some short Ada testcase where the DW_OP_call4 referring to
> DW_TAG_dwarf_procedure is supposed to be emitted?  I believe you must be
> getting there the .Ldebug_info0+0 invalid reference in the DW_OP_call4
> operand.

Sure! Here’s one:
> $ gcc -S -g -fgnat-encodings=minimal -dA foo.adb && grep DW_OP_call4 foo.s
> foo.s:313:      .byte   0x99    # DW_OP_call4

-- 
Pierre-Marie de Rodat

[-- Attachment #2: foo.adb --]
[-- Type: text/x-adasrc, Size: 293 bytes --]

procedure Foo is

   type Record_Type (N : Natural) is record
      S1 : String (1 .. N);
      S2 : String (1 .. N);
   end record;

   procedure Process (R : Record_Type) is
   begin
      null;
   end Process;

   R : Record_Type (4) := (4, "abcd", "efgh");

begin
   Process (R);
end Foo;

^ permalink raw reply	[flat|nested] 53+ messages in thread

* [PATCH] Fix DW_OP_GNU_implicit_pointer referring to DW_TAG_dwarf_procedure (PR debug/69947)
  2016-02-25 15:54                               ` Pierre-Marie de Rodat
@ 2016-02-25 16:46                                 ` Jakub Jelinek
  2016-02-25 20:55                                   ` Jakub Jelinek
  2016-02-26  8:59                                   ` Pierre-Marie de Rodat
  0 siblings, 2 replies; 53+ messages in thread
From: Jakub Jelinek @ 2016-02-25 16:46 UTC (permalink / raw)
  To: Pierre-Marie de Rodat, Jason Merrill
  Cc: gcc-patches, Cary Coutant, Eric Botcazou

On Thu, Feb 25, 2016 at 04:53:58PM +0100, Pierre-Marie de Rodat wrote:
> I introduced a DW_OP_call* traversal for this:
> 
>   * prune_unused_types_mark traverses attributes using
>     prune_unused_types_walk_attribs;
> 
>   * …_walk_attribs walks location descriptions and location lists using
>     …_walk_loc_descr
> 
>   * …_walk_loc_descr marks DWARF procedures referenced by DW_OP_call*
>     operations.

Ah, I've been looking for something that would set die_perennial_p, but
actually you just set die_mark later on instead for those.
So IMHO the right fix is just handle all the ops that could directly or
indirectly contain references to other DIEs, rather than just handling
the 3 you have there.

Going to bootstrap/regtest this on x86_64-linux and i686-linux now.

Is this ok for trunk if it passes testing?

2016-02-25  Jakub Jelinek  <jakub@redhat.com>

	PR debug/69947
	* dwarf2out.c (prune_unused_types_walk_loc_descr): Handle
	all other ops that have dw_val_class_die_ref operands,
	and DW_OP_GNU_entry_value.

	* gcc.dg/guality/pr69947.c: New test.

--- gcc/dwarf2out.c.jj	2016-02-25 17:04:11.465781368 +0100
+++ gcc/dwarf2out.c	2016-02-25 17:41:26.785371399 +0100
@@ -25641,11 +25641,29 @@ prune_unused_types_walk_loc_descr (dw_lo
   for (; loc != NULL; loc = loc->dw_loc_next)
     switch (loc->dw_loc_opc)
       {
+      case DW_OP_GNU_implicit_pointer:
+      case DW_OP_GNU_convert:
+      case DW_OP_GNU_reinterpret:
+	if (loc->dw_loc_oprnd1.val_class == dw_val_class_die_ref)
+	  prune_unused_types_mark (loc->dw_loc_oprnd1.v.val_die_ref.die, 1);
+	break;
       case DW_OP_call2:
       case DW_OP_call4:
       case DW_OP_call_ref:
+      case DW_OP_GNU_const_type:
+      case DW_OP_GNU_parameter_ref:
+	gcc_assert (loc->dw_loc_oprnd1.val_class == dw_val_class_die_ref);
 	prune_unused_types_mark (loc->dw_loc_oprnd1.v.val_die_ref.die, 1);
 	break;
+      case DW_OP_GNU_regval_type:
+      case DW_OP_GNU_deref_type:
+	gcc_assert (loc->dw_loc_oprnd2.val_class == dw_val_class_die_ref);
+	prune_unused_types_mark (loc->dw_loc_oprnd2.v.val_die_ref.die, 1);
+	break;
+      case DW_OP_GNU_entry_value:
+	gcc_assert (loc->dw_loc_oprnd1.val_class == dw_val_class_loc);
+	prune_unused_types_walk_loc_descr (loc->dw_loc_oprnd1.v.val_loc);
+	break;
       default:
 	break;
       }
--- gcc/testsuite/gcc.dg/guality/pr69947.c.jj	2016-02-25 17:22:13.729098931 +0100
+++ gcc/testsuite/gcc.dg/guality/pr69947.c	2016-02-25 17:22:13.729098931 +0100
@@ -0,0 +1,22 @@
+/* PR debug/69947 */
+/* { dg-do run } */
+/* { dg-options "-g" } */
+
+#include "../nop.h"
+
+static const char *c = "foobar";
+
+__attribute__((noinline, noclone)) void
+foo (void)
+{
+  static const char a[] = "abcdefg";
+  const char *b = a;		/* { dg-final { gdb-test 14 "c\[2\]" "'o'" } } */
+  asm (NOP : : : "memory");	/* { dg-final { gdb-test 14 "b\[4\]" "'e'" } } */
+}
+
+int
+main ()
+{
+  foo ();
+  return 0;
+}


	Jakub

^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCH] Fix DW_OP_GNU_implicit_pointer referring to DW_TAG_dwarf_procedure (PR debug/69947)
  2016-02-25 16:46                                 ` [PATCH] Fix DW_OP_GNU_implicit_pointer referring to DW_TAG_dwarf_procedure (PR debug/69947) Jakub Jelinek
@ 2016-02-25 20:55                                   ` Jakub Jelinek
  2016-02-26  8:59                                   ` Pierre-Marie de Rodat
  1 sibling, 0 replies; 53+ messages in thread
From: Jakub Jelinek @ 2016-02-25 20:55 UTC (permalink / raw)
  To: Pierre-Marie de Rodat, Jason Merrill
  Cc: gcc-patches, Cary Coutant, Eric Botcazou

On Thu, Feb 25, 2016 at 05:46:40PM +0100, Jakub Jelinek wrote:
> On Thu, Feb 25, 2016 at 04:53:58PM +0100, Pierre-Marie de Rodat wrote:
> > I introduced a DW_OP_call* traversal for this:
> > 
> >   * prune_unused_types_mark traverses attributes using
> >     prune_unused_types_walk_attribs;
> > 
> >   * …_walk_attribs walks location descriptions and location lists using
> >     …_walk_loc_descr
> > 
> >   * …_walk_loc_descr marks DWARF procedures referenced by DW_OP_call*
> >     operations.
> 
> Ah, I've been looking for something that would set die_perennial_p, but
> actually you just set die_mark later on instead for those.
> So IMHO the right fix is just handle all the ops that could directly or
> indirectly contain references to other DIEs, rather than just handling
> the 3 you have there.
> 
> Going to bootstrap/regtest this on x86_64-linux and i686-linux now.
> 
> Is this ok for trunk if it passes testing?

Successfully bootstrapped/regtested on x86_64-linux and i686-linux.

> 2016-02-25  Jakub Jelinek  <jakub@redhat.com>
> 
> 	PR debug/69947
> 	* dwarf2out.c (prune_unused_types_walk_loc_descr): Handle
> 	all other ops that have dw_val_class_die_ref operands,
> 	and DW_OP_GNU_entry_value.
> 
> 	* gcc.dg/guality/pr69947.c: New test.

	Jakub

^ permalink raw reply	[flat|nested] 53+ messages in thread

* Re: [PATCH] Fix DW_OP_GNU_implicit_pointer referring to DW_TAG_dwarf_procedure (PR debug/69947)
  2016-02-25 16:46                                 ` [PATCH] Fix DW_OP_GNU_implicit_pointer referring to DW_TAG_dwarf_procedure (PR debug/69947) Jakub Jelinek
  2016-02-25 20:55                                   ` Jakub Jelinek
@ 2016-02-26  8:59                                   ` Pierre-Marie de Rodat
  1 sibling, 0 replies; 53+ messages in thread
From: Pierre-Marie de Rodat @ 2016-02-26  8:59 UTC (permalink / raw)
  To: Jakub Jelinek, Jason Merrill; +Cc: gcc-patches, Cary Coutant, Eric Botcazou

On 02/25/2016 05:46 PM, Jakub Jelinek wrote:
> Ah, I've been looking for something that would set die_perennial_p, but
> actually you just set die_mark later on instead for those.
> So IMHO the right fix is just handle all the ops that could directly or
> indirectly contain references to other DIEs, rather than just handling
> the 3 you have there.

Agreed! (as per the patch I sent)

> Going to bootstrap/regtest this on x86_64-linux and i686-linux now.
>
> Is this ok for trunk if it passes testing?

I guess this was not for me as I’m not maintainer, but: this looks 
completely fine to me. :-) Thanks!

-- 
Pierre-Marie de Rodat

^ permalink raw reply	[flat|nested] 53+ messages in thread

end of thread, other threads:[~2016-02-26  8:59 UTC | newest]

Thread overview: 53+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2015-07-16  8:36 [PATCHES] Enhance standard DWARF for Ada Pierre-Marie de Rodat
2015-07-16  8:42 ` [PATCH 1/8] Add a flag to control the balance between GNAT encodings, and std. DWARF Pierre-Marie de Rodat
2015-07-16  9:18   ` Andreas Schwab
2015-07-16 10:16     ` Richard Biener
2015-07-16 10:19       ` Pierre-Marie de Rodat
2015-07-16  8:43 ` [PATCH 2/8] DWARF: handle variable-length records and variant parts Pierre-Marie de Rodat
2015-07-16  9:00   ` Pierre-Marie de Rodat
2015-07-16  8:44 ` [PATCH 3/8] DWARF: add a language hook to override types in debugging information Pierre-Marie de Rodat
2015-07-16  8:45 ` [PATCH 4/8] DWARF: add a language hook for fixed-point types Pierre-Marie de Rodat
2015-08-18  8:32   ` Pierre-Marie de Rodat
2015-07-16  8:46 ` [PATCH 5/8] DWARF: describe Ada dynamic arrays as proper arrays Pierre-Marie de Rodat
2015-07-16  8:49 ` [PATCH 6/8] create a macro for max dimensions for array descr. lang. hook Pierre-Marie de Rodat
2015-07-16  8:51 ` [PATCH 7/8] DWARF: add a language hook for scalar biased types Pierre-Marie de Rodat
2015-08-18  8:16   ` Pierre-Marie de Rodat
2015-07-16  8:53 ` [PATCH 8/8] DWARF: describe properly Ada packed arrays Pierre-Marie de Rodat
2015-07-23 10:59 ` [PATCHES, PING] Enhance standard DWARF for Ada Pierre-Marie de Rodat
2015-07-31 11:04   ` [PATCHES, PING*2] " Pierre-Marie de Rodat
2015-07-31 11:31     ` Pierre-Marie de Rodat
2015-08-08  9:01       ` [PATCHES, PING*3] " Pierre-Marie de Rodat
2015-08-31  9:15         ` [PATCHES, PING*4] " Pierre-Marie de Rodat
2015-10-20 20:20           ` [PATCHES, PING*5] " Pierre-Marie de Rodat
2015-11-18 20:35             ` Jason Merrill
2015-11-23 14:01               ` Pierre-Marie de Rodat
2015-11-23 21:11                 ` Jason Merrill
2015-11-24  9:19                   ` Pierre-Marie de Rodat
2015-11-25 18:36                     ` Jason Merrill
2015-11-26 12:37                       ` Pierre-Marie de Rodat
2015-12-03 10:35                         ` [PATCHES, PING] " Pierre-Marie de Rodat
2015-12-10  7:18                           ` [PATCHES, PING*2] " Pierre-Marie de Rodat
2015-12-11 20:25                         ` [PATCHES, PING*5] " Jason Merrill
2015-12-16  8:53                           ` Pierre-Marie de Rodat
2015-12-16 21:30                             ` Jason Merrill
2015-12-17 14:10                               ` Pierre-Marie de Rodat
2015-12-18 17:56                                 ` Jason Merrill
2015-12-18 17:58                                   ` Jakub Jelinek
2015-12-18 18:22                                     ` Eric Botcazou
2016-01-02 21:37                                       ` Andreas Schwab
2016-01-02 23:45                                         ` Eric Botcazou
2016-01-05  9:02                                           ` Pierre-Marie de Rodat
2015-12-18 20:23                                   ` Pierre-Marie de Rodat
2015-12-21 14:16                                     ` Pierre-Marie de Rodat
2015-12-21 15:40                                       ` Jason Merrill
2015-12-21 15:44                                         ` Pierre-Marie de Rodat
2016-02-25  9:48                             ` Jakub Jelinek
2016-02-25 10:35                               ` Pierre-Marie de Rodat
2016-02-25 10:45                                 ` Jakub Jelinek
2016-02-25 12:23                                   ` Eric Botcazou
2016-02-25 15:51                                 ` Jakub Jelinek
2016-02-25 15:59                                   ` Pierre-Marie de Rodat
2016-02-25 15:54                               ` Pierre-Marie de Rodat
2016-02-25 16:46                                 ` [PATCH] Fix DW_OP_GNU_implicit_pointer referring to DW_TAG_dwarf_procedure (PR debug/69947) Jakub Jelinek
2016-02-25 20:55                                   ` Jakub Jelinek
2016-02-26  8:59                                   ` Pierre-Marie de Rodat

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).