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.

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.

From-SVN: r231764

1 files changed, 82 insertions, 0 deletions

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