ada-tree.h (DECL_PARALLEL_TYPE): New language specific attribute...

2008-06-06  Nicolas Setton  <setton@adacore.com>
            Olivier Hainque  <hainque@adacore.com>

        * ada-tree.h (DECL_PARALLEL_TYPE): New language specific
        attribute, parallel descriptive type attached to another type
        for debug info generation purposes.
        * utils.c (add_parallel_type): New function, register parallel
        type to be attached to a type.
        (get_parallel_type): New function, fetch a registered parallel
        type, if any.
        (rest_of_record_type_compilation): Register the parallel type we
        make for variable size records.
        * gigi.h (add_parallel_type, get_parallel_type): Declare.
        * decl.c (gnat_to_gnu_entity, maybe_pad_type): Register the
        parallel debug types we make.
        * trans.c (extract_encoding, decode_name): New functions.
        (gigi): If the DWARF attribute extensions are available, setup
        to use them.
        * lang.opt: Register language specific processing request
        for -gdwarf+.
        * misc.c (gnat_dwarf_extensions): New global variable.  How much
        do we want of our DWARF extensions. 0 by default.
        (gnat_handle_option) <OPT_gdwarf_>: Increment gnat_dwarf_extensions.
        (gnat_post_options): Map gnat_dwarf_extensions to the common
        use_gnu_debug_info_extensions for later processing.


Co-Authored-By: Olivier Hainque <hainque@adacore.com>

From-SVN: r136506

gcc/ChangeLog

+2008-06-06  Nicolas Setton  <setton@adacore.com>
+	    Olivier Hainque  <hainque@adacore.com>
+
+	* ada-tree.h (DECL_PARALLEL_TYPE): New language specific
+	attribute, parallel descriptive type attached to another
+	type for debug info generation purposes.
+	* utils.c (add_parallel_type): New function, register
+	parallel type to be attached to a type.
+	(get_parallel_type): New function, fetch a registered
+	parallel type, if any.
+	(rest_of_record_type_compilation): Register the parallel
+	type we	make for variable size records.
+	* gigi.h (add_parallel_type, get_parallel_type): Declare.
+	* decl.c (gnat_to_gnu_entity, maybe_pad_type): Register	the
+	parallel debug types we make.
+	* trans.c (extract_encoding, decode_name): New functions.
+	(gigi): If the DWARF attribute extensions are available, setup
+	to use them.
+	* lang.opt: Register language specific processing request
+	for -gdwarf+.
+	* misc.c (gnat_dwarf_extensions): New global variable. How much
+	do we want of our DWARF extensions. 0 by default.
+	(gnat_handle_option) <OPT_gdwarf_>: Increment gnat_dwarf_extensions.
+	(gnat_post_options): Map gnat_dwarf_extensions to the
+	commonuse_gnu_debug_info_extensions for later processing.
+	
 2008-06-06 Uros Bizjak <ubizjak@gmail.com>
 
 	PR rtl-optimization/36438

gcc/ada/ada-tree.h

@@ -290,6 +290,12 @@ struct lang_type GTY(()) {tree t; };
 #define SET_DECL_RENAMED_OBJECT(NODE, X) \
   SET_DECL_LANG_SPECIFIC (VAR_DECL_CHECK (NODE), X)
 
+/* In a TYPE_DECL, points to the parallel type if any, otherwise 0.  */
+#define DECL_PARALLEL_TYPE(NODE) \
+  GET_DECL_LANG_SPECIFIC (TYPE_DECL_CHECK (NODE))
+#define SET_DECL_PARALLEL_TYPE(NODE, X) \
+  SET_DECL_LANG_SPECIFIC (TYPE_DECL_CHECK (NODE), X)
+
 /* In a FUNCTION_DECL, points to the stub associated with the function
    if any, otherwise 0.  */
 #define DECL_FUNCTION_STUB(NODE) \

gcc/ada/decl.c

@@ -2376,6 +2376,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
 	      finish_record_type (gnu_bound_rec_type, gnu_field_list,
 				  0, false);
+
+	      TYPE_STUB_DECL (gnu_type)
+		= build_decl (TYPE_DECL, NULL_TREE, gnu_type);
+
+	      add_parallel_type
+		(TYPE_STUB_DECL (gnu_type), gnu_bound_rec_type);
 	    }
 
 	  TYPE_CONVENTION_FORTRAN_P (gnu_type)
@@ -3106,6 +3112,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 							 0, NULL_TREE,
 							 NULL_TREE, 0),
 				      0, false);
+
+		  add_parallel_type (TYPE_STUB_DECL (gnu_type),
+				     gnu_subtype_marker);
 		}
 
 	      /* Now we can finalize it.  */
@@ -5767,6 +5776,8 @@ maybe_pad_type (tree type, tree size, unsigned int align,
 					     0),
 			  0, false);
 
+      add_parallel_type (TYPE_STUB_DECL (record), marker);
+
       if (size && TREE_CODE (size) != INTEGER_CST && definition)
 	create_var_decl (concat_id_with_name (name, "XVZ"), NULL_TREE,
 			 bitsizetype, TYPE_SIZE (record), false, false, false,

gcc/ada/gigi.h

@@ -535,6 +535,12 @@ extern void finish_record_type (tree record_type, tree fieldlist,
    so, unless explicitly requested not to through DO_NOT_FINALIZE.  */
 extern void rest_of_record_type_compilation (tree record_type);
 
+/* Append PARALLEL_TYPE on the chain of parallel types for decl.  */
+extern void add_parallel_type (tree decl, tree parallel_type);
+
+/* Return the parallel type associated to a type, if any.  */
+extern tree get_parallel_type (tree type);
+
 /* Returns a FUNCTION_TYPE node. RETURN_TYPE is the type returned by the
    subprogram. If it is void_type_node, then we are dealing with a procedure,
    otherwise we are dealing with a function. PARAM_DECL_LIST is a list of

gcc/ada/lang.opt

@@ -83,6 +83,10 @@ fRTS=
 Ada Joined RejectNegative
 ; Selects the runtime
 
+gdwarf+
+Ada
+; Explicit request for dwarf debug info with GNAT specific extensions.
+
 gant
 Ada Joined Undocumented
 ; Catches typos

gcc/ada/misc.c

@@ -199,6 +199,13 @@ const char *const tree_code_name[] = {
 };
 #undef DEFTREECODE
 
+/* How much we want of our DWARF extensions.  Some of our dwarf+ extensions
+   are incompatible with regular GDB versions, so we must make sure to only
+   produce them on explicit request.  This is eventually reflected into the
+   use_gnu_debug_info_extensions common flag for later processing.  */
+
+static int gnat_dwarf_extensions = 0;
+
 /* Command-line argc and argv.
    These variables are global, since they are imported and used in
    back_end.adb  */
@@ -334,6 +341,10 @@ gnat_handle_option (size_t scode, const char *arg, int value)
       gnat_argc++;
       break;
 
+    case OPT_gdwarf_:
+      gnat_dwarf_extensions ++;
+      break;
+
     default:
       gcc_unreachable ();
     }
@@ -383,6 +394,11 @@ gnat_post_options (const char **pfilename ATTRIBUTE_UNUSED)
   else
     flag_eliminate_unused_debug_types = 0;
 
+  /* Reflect the explicit request of DWARF extensions into the common
+     flag for use by later passes.  */
+  if (write_symbols == DWARF2_DEBUG)
+    use_gnu_debug_info_extensions = gnat_dwarf_extensions > 0;
+
   return false;
 }
 

gcc/ada/trans.c

@@ -56,6 +56,10 @@
 #include "einfo.h"
 #include "ada-tree.h"
 #include "gigi.h"
+#include "adadecode.h"
+
+#include "dwarf2.h"
+#include "dwarf2out.h"
 
 /* We should avoid allocating more than ALLOCA_THRESHOLD bytes via alloca,
    for fear of running out of stack space.  If we need more, we use xmalloc
@@ -212,6 +216,11 @@ static tree gnat_stabilize_reference_1 (tree, bool);
 static void set_expr_location_from_node (tree, Node_Id);
 static int lvalue_required_p (Node_Id, tree, int);
 
+/* Hooks for debug info back-ends, only supported and used in a restricted set
+   of configurations.  */
+static const char *extract_encoding (const char *) ATTRIBUTE_UNUSED;
+static const char *decode_name (const char *) ATTRIBUTE_UNUSED;
+
 /* This is the main program of the back-end.  It sets up all the table
    structures and then generates code.  */
 
@@ -282,6 +291,18 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name,
       TYPE_SIZE_UNIT (void_type_node) = size_zero_node;
     }
 
+  /* If the GNU type extensions to DWARF are available, setup the hooks.  */
+#if defined (DWARF2_DEBUGGING_INFO) && defined (DWARF2_GNU_TYPE_EXTENSIONS)
+  /* We condition the name demangling and the generation of type encoding
+     strings on -gdwarf+ and always set descriptive types on.  */
+  if (use_gnu_debug_info_extensions)
+    {
+      dwarf2out_set_type_encoding_func (extract_encoding);
+      dwarf2out_set_demangle_name_func (decode_name);
+    }
+  dwarf2out_set_descriptive_type_func (get_parallel_type);
+#endif
+
   /* Enable GNAT stack checking method if needed */
   if (!Stack_Check_Probes_On_Target)
     set_stack_check_libfunc (gen_rtx_SYMBOL_REF (Pmode, "_gnat_stack_check"));
@@ -6895,6 +6916,31 @@ set_expr_location_from_node (tree node, Node_Id gnat_node)
   set_expr_location (node, locus);
 }
 
+/* Return a colon-separated list of encodings contained in encoded Ada
+   name.  */
+
+static const char *
+extract_encoding (const char *name)
+{
+  char *encoding = ggc_alloc (strlen (name));
+  
+  get_encoding (name, encoding);
+  
+  return encoding;
+}
+
+/* Extract the Ada name from an encoded name.  */
+
+static const char *
+decode_name (const char *name)
+{
+  char *decoded = ggc_alloc (strlen (name) * 2 + 60);
+  
+  __gnat_decode (name, decoded, 0);
+  
+  return decoded;
+}
+
 /* Post an error message.  MSG is the error message, properly annotated.
    NODE is the node at which to post the error and the node to use for the
    "&" substitution.  */

gcc/ada/utils.c

@@ -1059,6 +1059,8 @@ rest_of_record_type_compilation (tree record_type)
       TYPE_SIZE_UNIT (new_record_type)
 	= size_int (TYPE_ALIGN (record_type) / BITS_PER_UNIT);
 
+      add_parallel_type (TYPE_STUB_DECL (record_type), new_record_type);
+
       /* Now scan all the fields, replacing each field with a new
 	 field corresponding to the new encoding.  */
       for (old_field = TYPE_FIELDS (record_type); old_field;
@@ -1201,6 +1203,30 @@ rest_of_record_type_compilation (tree record_type)
   rest_of_type_decl_compilation (TYPE_STUB_DECL (record_type));
 }
 
+/* Append PARALLEL_TYPE on the chain of parallel types for decl.  */
+
+void
+add_parallel_type (tree decl, tree parallel_type)
+{
+  tree d = decl;
+
+  while (DECL_PARALLEL_TYPE (d))
+    d = TYPE_STUB_DECL (DECL_PARALLEL_TYPE (d));
+
+  SET_DECL_PARALLEL_TYPE (d, parallel_type);
+}
+
+/* Return the parallel type associated to a type, if any.  */
+
+tree
+get_parallel_type (tree type)
+{
+  if (TYPE_STUB_DECL (type))
+    return DECL_PARALLEL_TYPE (TYPE_STUB_DECL (type));
+  else
+    return NULL_TREE;
+}
+
 /* Utility function of above to merge LAST_SIZE, the previous size of a record
    with FIRST_BIT and SIZE that describe a field.  SPECIAL is nonzero
    if this represents a QUAL_UNION_TYPE in which case we must look for