exp_dbug.adb (Debug_Renaming_Declaration): Process underlying types.

	* exp_dbug.adb (Debug_Renaming_Declaration): Process underlying types.
	Emit GNAT encodings for object renamings involving record components
	whose normalized bit offset is not null.
	* uintp.h (UI_No_Uint): Declare.
	* gcc-interface/gigi.h (can_materialize_object_renaming_p): New.
	* gcc-interface/utils.c (can_materialize_object_renaming_p): New
	function.
	* gcc-interface/trans.c (gnat_to_gnu) <N_Object_Renaming_Declaration>:
	In code generation mode, materialize all renamings as long as they need
	debug info and we are not optimizing.

From-SVN: r240985

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 6b3b9e069742347f0c54c90bfa71a17a3fd17a8a..c2592cf12bf24045f858a686fafbcaef034402cf 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,16 @@
+2016-10-11  Pierre-Marie de Rodat  <derodat@adacore.com>
+
+       * exp_dbug.adb (Debug_Renaming_Declaration): Process underlying types.
+       Emit GNAT encodings for object renamings involving record components
+       whose normalized bit offset is not null.
+       * uintp.h (UI_No_Uint): Declare.
+       * gcc-interface/gigi.h (can_materialize_object_renaming_p): New.
+       * gcc-interface/utils.c (can_materialize_object_renaming_p): New
+       function.
+       * gcc-interface/trans.c (gnat_to_gnu) <N_Object_Renaming_Declaration>:
+       In code generation mode, materialize all renamings as long as they need
+       debug info and we are not optimizing.
+
 2016-10-11  Pierre-Marie de Rodat  <derodat@adacore.com>
 
        * gcc-interface/utils2.c (build_binary_op): Add a NO_FOLD

diff --git a/gcc/ada/exp_dbug.adb b/gcc/ada/exp_dbug.adb
index df0543d4cb06fdbd66d0f8ccac43a631c617cf02..71454509216001fe7f9199a586d2113e2ea4bf29 100644 (file)
--- a/gcc/ada/exp_dbug.adb
+++ b/gcc/ada/exp_dbug.adb
@@ -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");

diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h
index b001b405fe07fa9b5e9965f5f396a11385e18750..1d87b5be44e6c6b1356fa68d9fc298ded4cbb277 100644 (file)
--- a/gcc/ada/gcc-interface/gigi.h
+++ b/gcc/ada/gcc-interface/gigi.h
@@ -1014,6 +1014,11 @@ extern void process_deferred_decl_context (bool force);
    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

diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 930725b911d4fc223a3a7b619e68588674d8ec7b..7b319d45a1509a5a533f730fb8f8fdd0193c5e9e 100644 (file)
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -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))

diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index 221b0b5171388dba4f080656156e34c9eca6f84f..21e12658380a5a36862f63e038986777944e2c5c 100644 (file)
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -6185,6 +6185,58 @@ handle_vector_type_attribute (tree *node, tree name, tree ARG_UNUSED (args),
   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                          *
  * ----------------------------------------------------------------------- */

diff --git a/gcc/ada/uintp.h b/gcc/ada/uintp.h
index 1f4e7a3e7bf6c83beb3dc387cd0c9b137f7240b6..fafa13903b88a8b9869c520cde6e555ec792807b 100644 (file)
--- a/gcc/ada/uintp.h
+++ b/gcc/ada/uintp.h
@@ -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.  */