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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@231764 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 70 insertions, 2 deletions

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 385b720506a..760c7f439f1 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"
@@ -1619,13 +1620,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