From 6892758d5cf458b63c63d869bb547bf0c5369820 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Tue, 4 Nov 2014 12:04:24 +0100
Subject: [PATCH 4/8] 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.
include/ChangeLog:
* dwarf2.def (DW_TAG_GNU_rational_constant): New tag.
(DW_AT_GNU_numerator, DW_AT_GNU_denominator): New attributes.
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.
---
gcc/ada/gcc-interface/ada-tree.def | 5 +++
gcc/ada/gcc-interface/ada-tree.h | 17 ++++++++
gcc/ada/gcc-interface/decl.c | 72 ++++++++++++++++++++++++++++++++-
gcc/ada/gcc-interface/misc.c | 82 ++++++++++++++++++++++++++++++++++++++
gcc/dwarf2out.c | 52 ++++++++++++++++++++++++
gcc/dwarf2out.h | 29 ++++++++++++++
gcc/langhooks-def.h | 4 +-
gcc/langhooks.h | 5 +++
8 files changed, 263 insertions(+), 3 deletions(-)
@@ -47,6 +47,11 @@ DEFTREECODE (PLUS_NOMOD_EXPR, "plus_nomod_expr", tcc_binary, 2)
This is used for loops and never shows up in the tree. */
DEFTREECODE (MINUS_NOMOD_EXPR, "minus_nomod_expr", tcc_binary, 2)
+/* An expression that computes an exponentiation. Operand 0 is the base and
+ Operand 1 is the exponent. This node is never passed to GCC: it is only
+ used internally to describe fixed point types scale factors. */
+DEFTREECODE (POWER_EXPR, "power_expr", tcc_binary, 2)
+
/* Same as ADDR_EXPR, except that if the operand represents a bit field,
return the address of the byte containing the bit. This is used
for the Address attribute and never shows up in the tree. */
@@ -126,6 +126,13 @@ do { \
#define TYPE_CONTAINS_TEMPLATE_P(NODE) \
TYPE_LANG_FLAG_3 (RECORD_OR_UNION_CHECK (NODE))
+/* For INTEGER_TYPE, nonzero if it implements a fixed-point type. */
+#define TYPE_FIXED_POINT_P(NODE) \
+ TYPE_LANG_FLAG_3 (INTEGER_TYPE_CHECK (NODE))
+
+#define TYPE_IS_FIXED_POINT_P(NODE) \
+ (TREE_CODE (NODE) == INTEGER_TYPE && TYPE_FIXED_POINT_P (NODE))
+
/* True if NODE is a thin pointer. */
#define TYPE_IS_THIN_POINTER_P(NODE) \
(POINTER_TYPE_P (NODE) \
@@ -354,6 +361,16 @@ do { \
#define SET_TYPE_DEBUG_TYPE(NODE, X) \
SET_TYPE_LANG_SPECIFIC2(NODE, X)
+/* For an INTEGER_TYPE with TYPE_IS_FIXED_POINT_P, this is the value of the
+ scale factor. Modular types, index types (sizetype subtypes) and
+ fixed-point types are totally distinct types, so there is no problem with
+ sharing type lang specific's first slot. */
+#define TYPE_SCALE_FACTOR(NODE) \
+ GET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))
+#define SET_TYPE_SCALE_FACTOR(NODE, X) \
+ SET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE), X)
+
+
/* Flags added to decl nodes. */
/* Nonzero in a FUNCTION_DECL that represents a stubbed function
@@ -51,6 +51,7 @@
#include "snames.h"
#include "stringt.h"
#include "uintp.h"
+#include "urealp.h"
#include "fe.h"
#include "sinfo.h"
#include "einfo.h"
@@ -1632,13 +1633,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
@@ -472,6 +472,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);
@@ -570,6 +573,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. */
@@ -973,6 +1051,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);
@@ -1044,6 +1123,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
@@ -10790,6 +10790,8 @@ base_type_die (tree type)
{
dw_die_ref base_type_result;
enum dwarf_type encoding;
+ bool fpt_used = false;
+ struct fixed_point_type_info fpt_info;
if (TREE_CODE (type) == ERROR_MARK || TREE_CODE (type) == VOID_TYPE)
return 0;
@@ -10816,6 +10818,19 @@ base_type_die (tree type)
break;
}
}
+ if ((dwarf_version >= 3 || !dwarf_strict)
+ && lang_hooks.types.get_fixed_point_type_info)
+ {
+ memset (&fpt_info, 0, sizeof (fpt_info));
+ if (lang_hooks.types.get_fixed_point_type_info (type, &fpt_info))
+ {
+ fpt_used = true;
+ encoding = ((TYPE_UNSIGNED (type))
+ ? DW_ATE_unsigned_fixed
+ : DW_ATE_signed_fixed);
+ break;
+ }
+ }
if (TYPE_STRING_FLAG (type))
{
if (TYPE_UNSIGNED (type))
@@ -10874,6 +10889,43 @@ base_type_die (tree type)
add_AT_unsigned (base_type_result, DW_AT_byte_size,
int_size_in_bytes (type));
add_AT_unsigned (base_type_result, DW_AT_encoding, encoding);
+
+ if (fpt_used)
+ {
+ switch (fpt_info.scale_factor_kind)
+ {
+ case fixed_point_scale_factor_binary:
+ add_AT_int (base_type_result, DW_AT_binary_scale,
+ fpt_info.scale_factor.binary);
+ break;
+
+ case fixed_point_scale_factor_decimal:
+ add_AT_int (base_type_result, DW_AT_decimal_scale,
+ fpt_info.scale_factor.decimal);
+ break;
+
+ case fixed_point_scale_factor_arbitrary:
+ /* Arbitrary scale factors cannot be describe in standard DWARF,
+ yet. */
+ if (!dwarf_strict)
+ {
+ /* Describe the scale factor as a rational constant. */
+ const dw_die_ref scale_factor
+ = new_die (DW_TAG_constant, comp_unit_die (), type);
+
+ add_AT_unsigned (scale_factor, DW_AT_GNU_numerator,
+ fpt_info.scale_factor.arbitrary.numerator);
+ add_AT_int (scale_factor, DW_AT_GNU_denominator,
+ fpt_info.scale_factor.arbitrary.denominator);
+
+ add_AT_die_ref (base_type_result, DW_AT_small, scale_factor);
+ }
+ break;
+
+ default:
+ gcc_unreachable ();
+ }
+ }
add_pubtype (type, base_type_result);
return base_type_result;
@@ -344,6 +344,35 @@ struct array_descr_info
} dimen[10];
};
+enum fixed_point_scale_factor
+{
+ fixed_point_scale_factor_binary,
+ fixed_point_scale_factor_decimal,
+ fixed_point_scale_factor_arbitrary
+};
+
+struct fixed_point_type_info
+{
+ /* A scale factor is the value one has to multiply with physical data in
+ order to get the fixed point logical data. The DWARF standard enables one
+ to encode it in three ways. */
+ enum fixed_point_scale_factor scale_factor_kind;
+ union
+ {
+ /* For binary scale factor, the scale factor is: 2 ** binary. */
+ int binary;
+ /* For decimal scale factor, the scale factor is: 10 ** binary. */
+ int decimal;
+ /* For arbitrary scale factor, the scale factor is:
+ numerator / denominator. */
+ struct
+ {
+ unsigned HOST_WIDE_INT numerator;
+ HOST_WIDE_INT denominator;
+ } arbitrary;
+ } scale_factor;
+};
+
void dwarf2out_c_finalize (void);
#endif /* GCC_DWARF2OUT_H */
@@ -177,6 +177,7 @@ extern tree lhd_make_node (enum tree_code);
#define LANG_HOOKS_RECONSTRUCT_COMPLEX_TYPE reconstruct_complex_type
#define LANG_HOOKS_ENUM_UNDERLYING_BASE_TYPE lhd_enum_underlying_base_type
#define LANG_HOOKS_GET_DEBUG_TYPE NULL
+#define LANG_HOOKS_GET_FIXED_POINT_TYPE_INFO NULL
#define LANG_HOOKS_FOR_TYPES_INITIALIZER { \
LANG_HOOKS_MAKE_TYPE, \
@@ -197,7 +198,8 @@ extern tree lhd_make_node (enum tree_code);
LANG_HOOKS_DESCRIPTIVE_TYPE, \
LANG_HOOKS_RECONSTRUCT_COMPLEX_TYPE, \
LANG_HOOKS_ENUM_UNDERLYING_BASE_TYPE, \
- LANG_HOOKS_GET_DEBUG_TYPE \
+ LANG_HOOKS_GET_DEBUG_TYPE, \
+ LANG_HOOKS_GET_FIXED_POINT_TYPE_INFO \
}
/* Declaration hooks. */
@@ -149,6 +149,11 @@ struct lang_hooks_for_types
middle-end uses specialized types, for instance constrained discriminated
types in Ada. */
tree (*get_debug_type) (const_tree);
+
+ /* Return TRUE if TYPE implements a fixed point type and fills in information
+ for the debugger about scale factor, etc. */
+ bool (*get_fixed_point_type_info) (const_tree,
+ struct fixed_point_type_info *);
};
/* Language hooks related to decls and the symbol table. */
--
2.4.6