===================================================================
@@ -333,7 +333,7 @@ package body Exp_Dbug is
----------------------------
procedure Enable_If_Packed_Array (N : Node_Id) is
- T : constant Entity_Id := Etype (N);
+ T : constant Entity_Id := Underlying_Type (Etype (N));
begin
Enable :=
Enable or else (Ekind (T) in Array_Kind
@@ -390,7 +390,16 @@ package body Exp_Dbug is
exit;
when N_Selected_Component =>
- Enable := Enable or else Is_Packed (Etype (Prefix (Ren)));
+ declare
+ First_Bit : constant Uint :=
+ Normalized_First_Bit (Entity (Selector_Name (Ren)));
+ begin
+ Enable :=
+ (Enable
+ or else Is_Packed (Underlying_Type (Etype (Prefix (Ren))))
+ or else (First_Bit /= No_Uint
+ and then First_Bit /= Uint_0));
+ end;
Prepend_String_To_Buffer
(Get_Name_String (Chars (Selector_Name (Ren))));
Prepend_String_To_Buffer ("XR");
===================================================================
@@ -1014,6 +1014,11 @@ extern void process_deferred_decl_contex
IS_SUBPROGRAM to whether the returned entity is a subprogram. */
extern Entity_Id get_debug_scope (Node_Id gnat_node, bool *is_subprogram);
+/* Return whether EXPR, which is the renamed object in an object renaming
+ declaration, can be materialized as a reference (REFERENCE_TYPE). This
+ should be synchronized with Exp_Dbug.Debug_Renaming_Declaration. */
+extern bool can_materialize_object_renaming_p (Node_Id expr);
+
#ifdef __cplusplus
extern "C" {
#endif
===================================================================
@@ -6084,10 +6084,18 @@ gnat_to_gnu (Node_Id gnat_node)
gnat_temp = Defining_Entity (gnat_node);
gnu_result = alloc_stmt_list ();
- /* Don't do anything if this renaming is handled by the front end or if
- we are just annotating types and this object has a composite or task
- type, don't elaborate it. */
- if (!Is_Renaming_Of_Object (gnat_temp)
+ /* Don't do anything if this renaming is handled by the front end and it
+ does not need debug info. Note that we consider renamings don't need
+ debug info when optimizing: our way to describe them has a
+ memory/elaboration footprint.
+
+ Don't do anything neither if we are just annotating types and this
+ object has a composite or task type, don't elaborate it. */
+ if ((!Is_Renaming_Of_Object (gnat_temp)
+ || (Needs_Debug_Info (gnat_temp)
+ && !optimize
+ && can_materialize_object_renaming_p
+ (Renamed_Object (gnat_temp))))
&& ! (type_annotate_only
&& (Is_Array_Type (Etype (gnat_temp))
|| Is_Record_Type (Etype (gnat_temp))
===================================================================
@@ -6185,6 +6185,58 @@ handle_vector_type_attribute (tree *node
return NULL_TREE;
}
+/* Return whether EXPR, which is the renamed object in an object renaming
+ declaration, can be materialized as a reference (REFERENCE_TYPE). This
+ should be synchronized with Exp_Dbug.Debug_Renaming_Declaration. */
+
+bool
+can_materialize_object_renaming_p (Node_Id expr)
+{
+ while (true)
+ {
+ switch Nkind (expr)
+ {
+ case N_Identifier:
+ case N_Expanded_Name:
+ return true;
+
+ case N_Selected_Component:
+ {
+ if (Is_Packed (Underlying_Type (Etype (Prefix (expr)))))
+ return false;
+
+ const Uint bitpos
+ = Normalized_First_Bit (Entity (Selector_Name (expr)));
+ if (!UI_Is_In_Int_Range (bitpos)
+ || (bitpos != UI_No_Uint && bitpos != UI_From_Int (0)))
+ return false;
+
+ expr = Prefix (expr);
+ break;
+ }
+
+ case N_Indexed_Component:
+ case N_Slice:
+ {
+ const Entity_Id t = Underlying_Type (Etype (Prefix (expr)));
+
+ if (Is_Array_Type (t) && Present (Packed_Array_Impl_Type (t)))
+ return false;
+
+ expr = Prefix (expr);
+ break;
+ }
+
+ case N_Explicit_Dereference:
+ expr = Prefix (expr);
+ break;
+
+ default:
+ return true;
+ };
+ }
+}
+
/* ----------------------------------------------------------------------- *
* BUILTIN FUNCTIONS *
* ----------------------------------------------------------------------- */
===================================================================
@@ -6,7 +6,7 @@
* *
* C Header File *
* *
- * Copyright (C) 1992-2014, Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2016, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
@@ -64,6 +64,10 @@ extern Uint UI_From_Int (int);
/* Similarly, but take a GCC INTEGER_CST. */
extern Uint UI_From_gnu (tree);
+/* A constant value indicating a missing or unset Uint value. */
+#define UI_No_Uint uintp__no_uint
+extern const Uint UI_No_Uint;
+
/* Uint values are represented as multiple precision integers stored in a
multi-digit format using UI_Base as the base. This value is chosen so
that the product UI_Base*UI_Base is within the range of Int values. */