diff options
Diffstat (limited to 'gcc/ada/gcc-interface')
| -rw-r--r-- | gcc/ada/gcc-interface/ada-tree.def | 5 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/ada-tree.h | 17 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/decl.c | 72 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/misc.c | 82 |
4 files changed, 174 insertions, 2 deletions
diff --git a/gcc/ada/gcc-interface/ada-tree.def b/gcc/ada/gcc-interface/ada-tree.def index 93967b5..8eb4688 100644 --- a/gcc/ada/gcc-interface/ada-tree.def +++ b/gcc/ada/gcc-interface/ada-tree.def @@ -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. */ diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h index 807da9d..709fdc2 100644 --- a/gcc/ada/gcc-interface/ada-tree.h +++ b/gcc/ada/gcc-interface/ada-tree.h @@ -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) \ @@ -358,6 +365,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 diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 385b720..760c7f4 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 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 |