diff options
Diffstat (limited to 'gcc/ada/gcc-interface')
| -rw-r--r-- | gcc/ada/gcc-interface/Makefile.in | 54 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/decl.c | 18 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/misc.c | 6 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/trans.c | 165 |
4 files changed, 155 insertions, 88 deletions
diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index 21bd1df2d09..58100bb96a3 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -732,7 +732,7 @@ ifeq ($(strip $(filter-out mips% wrs vx%,$(targ))),) endif ifeq ($(strip $(filter-out sparc% sun solaris%,$(targ))),) - LIBGNAT_TARGET_PAIRS_32 = \ + LIBGNAT_TARGET_PAIRS_COMMON = \ a-intnam.ads<a-intnam-solaris.ads \ s-inmaop.adb<s-inmaop-posix.adb \ s-intman.adb<s-intman-solaris.adb \ @@ -744,35 +744,29 @@ ifeq ($(strip $(filter-out sparc% sun solaris%,$(targ))),) s-tasinf.ads<s-tasinf-solaris.ads \ s-taspri.ads<s-taspri-solaris.ads \ s-tpopsp.adb<s-tpopsp-solaris.adb \ - g-soliop.ads<g-soliop-solaris.ads \ + g-soliop.ads<g-soliop-solaris.ads + + LIBGNAT_TARGET_PAIRS_32 = \ system.ads<system-solaris-sparc.ads LIBGNAT_TARGET_PAIRS_64 = \ - a-intnam.ads<a-intnam-solaris.ads \ - s-inmaop.adb<s-inmaop-posix.adb \ - s-intman.adb<s-intman-solaris.adb \ - s-osinte.adb<s-osinte-solaris.adb \ - s-osinte.ads<s-osinte-solaris.ads \ - s-osprim.adb<s-osprim-solaris.adb \ - s-taprop.adb<s-taprop-solaris.adb \ - s-tasinf.adb<s-tasinf-solaris.adb \ - s-tasinf.ads<s-tasinf-solaris.ads \ - s-taspri.ads<s-taspri-solaris.ads \ - s-tpopsp.adb<s-tpopsp-solaris.adb \ - g-soliop.ads<g-soliop-solaris.ads \ system.ads<system-solaris-sparcv9.ads ifeq ($(strip $(filter-out sparc sun solaris%,$(targ))),) ifeq ($(strip $(MULTISUBDIR)),/sparcv9) - LIBGNAT_TARGET_PAIRS = $(LIBGNAT_TARGET_PAIRS_64) + LIBGNAT_TARGET_PAIRS = \ + $(LIBGNAT_TARGET_PAIRS_COMMON) $(LIBGNAT_TARGET_PAIRS_64) else - LIBGNAT_TARGET_PAIRS = $(LIBGNAT_TARGET_PAIRS_32) + LIBGNAT_TARGET_PAIRS = \ + $(LIBGNAT_TARGET_PAIRS_COMMON) $(LIBGNAT_TARGET_PAIRS_32) endif else ifeq ($(strip $(MULTISUBDIR)),/sparcv7) - LIBGNAT_TARGET_PAIRS = $(LIBGNAT_TARGET_PAIRS_32) + LIBGNAT_TARGET_PAIRS = \ + $(LIBGNAT_TARGET_PAIRS_COMMON) $(LIBGNAT_TARGET_PAIRS_32) else - LIBGNAT_TARGET_PAIRS = $(LIBGNAT_TARGET_PAIRS_64) + LIBGNAT_TARGET_PAIRS = \ + $(LIBGNAT_TARGET_PAIRS_COMMON) $(LIBGNAT_TARGET_PAIRS_64) endif endif @@ -1501,7 +1495,7 @@ ifeq ($(strip $(filter-out powerpc% linux%,$(arch) $(osys))),) endif ifeq ($(strip $(filter-out sparc% linux%,$(arch) $(osys))),) - LIBGNAT_TARGET_PAIRS_32 = \ + LIBGNAT_TARGET_PAIRS_COMMON = \ a-intnam.ads<a-intnam-linux.ads \ s-inmaop.adb<s-inmaop-posix.adb \ s-intman.adb<s-intman-posix.adb \ @@ -1513,28 +1507,20 @@ ifeq ($(strip $(filter-out sparc% linux%,$(arch) $(osys))),) s-tasinf.ads<s-tasinf-linux.ads \ s-tasinf.adb<s-tasinf-linux.adb \ s-taspri.ads<s-taspri-posix-noaltstack.ads \ - s-tpopsp.adb<s-tpopsp-posix-foreign.adb \ + s-tpopsp.adb<s-tpopsp-posix-foreign.adb + + LIBGNAT_TARGET_PAIRS_32 = \ system.ads<system-linux-sparc.ads LIBGNAT_TARGET_PAIRS_64 = \ - a-intnam.ads<a-intnam-linux.ads \ - s-inmaop.adb<s-inmaop-posix.adb \ - s-intman.adb<s-intman-posix.adb \ - s-linux.ads<s-linux.ads \ - s-osinte.adb<s-osinte-posix.adb \ - s-osinte.ads<s-osinte-linux.ads \ - s-osprim.adb<s-osprim-posix.adb \ - s-taprop.adb<s-taprop-linux.adb \ - s-tasinf.ads<s-tasinf-linux.ads \ - s-tasinf.adb<s-tasinf-linux.adb \ - s-taspri.ads<s-taspri-posix-noaltstack.ads \ - s-tpopsp.adb<s-tpopsp-posix-foreign.adb \ system.ads<system-linux-sparcv9.ads ifeq ($(strip $(MULTISUBDIR)),/64) - LIBGNAT_TARGET_PAIRS = $(LIBGNAT_TARGET_PAIRS_64) + LIBGNAT_TARGET_PAIRS = \ + $(LIBGNAT_TARGET_PAIRS_COMMON) $(LIBGNAT_TARGET_PAIRS_64) else - LIBGNAT_TARGET_PAIRS = $(LIBGNAT_TARGET_PAIRS_32) + LIBGNAT_TARGET_PAIRS = \ + $(LIBGNAT_TARGET_PAIRS_COMMON) $(LIBGNAT_TARGET_PAIRS_32) endif TOOLS_TARGET_PAIRS = \ diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index cdee2277608..188b896180d 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -1318,6 +1318,24 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) get_block_jmpbuf_decl ())), gnat_entity); + /* If we are defining an Out parameter and we're not optimizing, + create a fake PARM_DECL for debugging purposes and make it + point to the VAR_DECL. Suppress debug info for the latter + but make sure it will still live on the stack so it can be + accessed from within the debugger through the PARM_DECL. */ + if (kind == E_Out_Parameter && definition && !optimize) + { + tree param = create_param_decl (gnu_entity_id, gnu_type, false); + gnat_pushdecl (param, gnat_entity); + SET_DECL_VALUE_EXPR (param, gnu_decl); + DECL_HAS_VALUE_EXPR_P (param) = 1; + if (debug_info_p) + debug_info_p = false; + else + DECL_IGNORED_P (param) = 1; + TREE_ADDRESSABLE (gnu_decl) = 1; + } + /* If this is a public constant or we're not optimizing and we're not making a VAR_DECL for it, make one just for export or debugger use. Likewise if the address is taken or if either the object or type is diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c index 7c7dc02f36f..3026e9057b9 100644 --- a/gcc/ada/gcc-interface/misc.c +++ b/gcc/ada/gcc-interface/misc.c @@ -603,10 +603,10 @@ gnat_printable_name (tree decl, int verbosity) if (verbosity == 2) { Set_Identifier_Casing (ada_name, (char *) DECL_SOURCE_FILE (decl)); - ada_name = Name_Buffer; + return ggc_strdup (Name_Buffer); } - - return (const char *) ada_name; + else + return ada_name; } /* Expands GNAT-specific GCC tree nodes. The only ones we support diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 6ade56869d9..005d517fda8 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -4159,12 +4159,33 @@ gnat_to_gnu (Node_Id gnat_node) gnu_rhs = maybe_unconstrained_array (gnat_to_gnu (Expression (gnat_node))); - /* If range check is needed, emit code to generate it */ + /* If range check is needed, emit code to generate it. */ if (Do_Range_Check (Expression (gnat_node))) gnu_rhs = emit_range_check (gnu_rhs, Etype (Name (gnat_node))); gnu_result = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_lhs, gnu_rhs); + + /* If the type being assigned is an array type and the two sides + are not completely disjoint, play safe and use memmove. */ + if (TREE_CODE (gnu_result) == MODIFY_EXPR + && Is_Array_Type (Etype (Name (gnat_node))) + && !(Forwards_OK (gnat_node) && Backwards_OK (gnat_node))) + { + tree to, from, size, to_ptr, from_ptr, t; + + to = TREE_OPERAND (gnu_result, 0); + from = TREE_OPERAND (gnu_result, 1); + + size = TYPE_SIZE_UNIT (TREE_TYPE (from)); + size = SUBSTITUTE_PLACEHOLDER_IN_EXPR (size, from); + + to_ptr = build_fold_addr_expr (to); + from_ptr = build_fold_addr_expr (from); + + t = implicit_built_in_decls[BUILT_IN_MEMMOVE]; + gnu_result = build_call_expr (t, 3, to_ptr, from_ptr, size); + } } break; @@ -5940,16 +5961,14 @@ process_decls (List_Id gnat_decls, List_Id gnat_decls2, } /* Make a unary operation of kind CODE using build_unary_op, but guard - the operation by an overflow check. CODE can be one of NEGATE_EXPR - or ABS_EXPR. GNU_TYPE is the type desired for the result. - Usually the operation is to be performed in that type. */ + the operation by an overflow check. CODE can be one of NEGATE_EXPR + or ABS_EXPR. GNU_TYPE is the type desired for the result. Usually + the operation is to be performed in that type. */ static tree -build_unary_op_trapv (enum tree_code code, - tree gnu_type, - tree operand) +build_unary_op_trapv (enum tree_code code, tree gnu_type, tree operand) { - gcc_assert ((code == NEGATE_EXPR) || (code == ABS_EXPR)); + gcc_assert (code == NEGATE_EXPR || code == ABS_EXPR); operand = protect_multiple_eval (operand); @@ -5959,15 +5978,13 @@ build_unary_op_trapv (enum tree_code code, CE_Overflow_Check_Failed); } -/* Make a binary operation of kind CODE using build_binary_op, but - guard the operation by an overflow check. CODE can be one of - PLUS_EXPR, MINUS_EXPR or MULT_EXPR. GNU_TYPE is the type desired - for the result. Usually the operation is to be performed in that type. */ +/* Make a binary operation of kind CODE using build_binary_op, but guard + the operation by an overflow check. CODE can be one of PLUS_EXPR, + MINUS_EXPR or MULT_EXPR. GNU_TYPE is the type desired for the result. + Usually the operation is to be performed in that type. */ static tree -build_binary_op_trapv (enum tree_code code, - tree gnu_type, - tree left, +build_binary_op_trapv (enum tree_code code, tree gnu_type, tree left, tree right) { tree lhs = protect_multiple_eval (left); @@ -5977,80 +5994,117 @@ build_binary_op_trapv (enum tree_code code, tree gnu_expr; tree tmp1, tmp2; tree zero = convert (gnu_type, integer_zero_node); - tree rhs_ge_zero; + tree rhs_lt_zero; tree check_pos; tree check_neg; - + tree check; int precision = TYPE_PRECISION (gnu_type); - /* Prefer a constant rhs to simplify checks */ + gcc_assert (!(precision & (precision - 1))); /* ensure power of 2 */ - if (TREE_CONSTANT (lhs) && !TREE_CONSTANT (rhs) - && commutative_tree_code (code)) + /* Prefer a constant or known-positive rhs to simplify checks. */ + if (!TREE_CONSTANT (rhs) + && commutative_tree_code (code) + && (TREE_CONSTANT (lhs) || (!tree_expr_nonnegative_p (rhs) + && tree_expr_nonnegative_p (lhs)))) { tree tmp = lhs; lhs = rhs; rhs = tmp; - } + } - /* In the case the right-hand size is still not constant, try to - use an exact operation in a wider type. */ + rhs_lt_zero = tree_expr_nonnegative_p (rhs) + ? integer_zero_node + : build_binary_op (LT_EXPR, integer_type_node, rhs, zero); + + /* ??? Should use more efficient check for operand_equal_p (lhs, rhs, 0) */ + + /* Try a few strategies that may be cheaper than the general + code at the end of the function, if the rhs is not known. + The strategies are: + - Call library function for 64-bit multiplication (complex) + - Widen, if input arguments are sufficiently small + - Determine overflow using wrapped result for addition/subtraction. */ if (!TREE_CONSTANT (rhs)) { - int needed_precision = code == MULT_EXPR ? 2 * precision : precision + 1; + /* Even for add/subtract double size to get another base type. */ + int needed_precision = precision * 2; if (code == MULT_EXPR && precision == 64) - { - return build_call_2_expr (mulv64_decl, lhs, rhs); + { + tree int_64 = gnat_type_for_size (64, 0); + + return convert (gnu_type, build_call_2_expr (mulv64_decl, + convert (int_64, lhs), + convert (int_64, rhs))); } - else if (needed_precision <= LONG_LONG_TYPE_SIZE) + + else if (needed_precision <= BITS_PER_WORD + || (code == MULT_EXPR + && needed_precision <= LONG_LONG_TYPE_SIZE)) { - tree calc_type = gnat_type_for_size (needed_precision, 0); - tree result; - tree check; + tree wide_type = gnat_type_for_size (needed_precision, 0); - result = build_binary_op (code, calc_type, - convert (calc_type, lhs), - convert (calc_type, rhs)); + tree wide_result = build_binary_op (code, wide_type, + convert (wide_type, lhs), + convert (wide_type, rhs)); - check = build_binary_op + tree check = build_binary_op (TRUTH_ORIF_EXPR, integer_type_node, - build_binary_op (LT_EXPR, integer_type_node, result, - convert (calc_type, type_min)), - build_binary_op (GT_EXPR, integer_type_node, result, - convert (calc_type, type_max))); + build_binary_op (LT_EXPR, integer_type_node, wide_result, + convert (wide_type, type_min)), + build_binary_op (GT_EXPR, integer_type_node, wide_result, + convert (wide_type, type_max))); - result = convert (gnu_type, result); + tree result = convert (gnu_type, wide_result); return emit_check (check, result, CE_Overflow_Check_Failed); } - } - gnu_expr = build_binary_op (code, gnu_type, lhs, rhs); - rhs_ge_zero = build_binary_op (GE_EXPR, integer_type_node, rhs, zero); + else if (code == PLUS_EXPR || code == MINUS_EXPR) + { + tree unsigned_type = gnat_type_for_size (precision, 1); + tree wrapped_expr = convert + (gnu_type, build_binary_op (code, unsigned_type, + convert (unsigned_type, lhs), + convert (unsigned_type, rhs))); + + tree result = convert + (gnu_type, build_binary_op (code, gnu_type, lhs, rhs)); + + /* Overflow when (rhs < 0) ^ (wrapped_expr < lhs)), for addition + or when (rhs < 0) ^ (wrapped_expr > lhs) for subtraction. */ + tree check = build_binary_op + (TRUTH_XOR_EXPR, integer_type_node, rhs_lt_zero, + build_binary_op (code == PLUS_EXPR ? LT_EXPR : GT_EXPR, + integer_type_node, wrapped_expr, lhs)); + + return emit_check (check, result, CE_Overflow_Check_Failed); + } + } switch (code) { case PLUS_EXPR: - /* When rhs >= 0, overflow when lhs > type_max - rhs */ + /* When rhs >= 0, overflow when lhs > type_max - rhs. */ check_pos = build_binary_op (GT_EXPR, integer_type_node, lhs, build_binary_op (MINUS_EXPR, gnu_type, type_max, rhs)), - /* When rhs < 0, overflow when lhs < type_min - rhs */ + /* When rhs < 0, overflow when lhs < type_min - rhs. */ check_neg = build_binary_op (LT_EXPR, integer_type_node, lhs, build_binary_op (MINUS_EXPR, gnu_type, type_min, rhs)); break; case MINUS_EXPR: - /* When rhs >= 0, overflow when lhs < type_min + rhs */ + /* When rhs >= 0, overflow when lhs < type_min + rhs. */ check_pos = build_binary_op (LT_EXPR, integer_type_node, lhs, build_binary_op (PLUS_EXPR, gnu_type, type_min, rhs)), - /* When rhs < 0, overflow when lhs > type_max + rhs */ + /* When rhs < 0, overflow when lhs > type_max + rhs. */ check_neg = build_binary_op (GT_EXPR, integer_type_node, lhs, build_binary_op (PLUS_EXPR, gnu_type, type_max, rhs)); @@ -6058,6 +6112,7 @@ build_binary_op_trapv (enum tree_code code, case MULT_EXPR: /* The check here is designed to be efficient if the rhs is constant, + but it will work for any rhs by using integer division. Four different check expressions determine wether X * C overflows, depending on C. C == 0 => false @@ -6087,14 +6142,22 @@ build_binary_op_trapv (enum tree_code code, gcc_unreachable(); } - return emit_check (fold_build3 (COND_EXPR, integer_type_node, rhs_ge_zero, - check_pos, check_neg), - gnu_expr, CE_Overflow_Check_Failed); + gnu_expr = build_binary_op (code, gnu_type, lhs, rhs); + + /* If we can fold the expression to a constant, just return it. + The caller will deal with overflow, no need to generate a check. */ + if (TREE_CONSTANT (gnu_expr)) + return gnu_expr; + + check = fold_build3 (COND_EXPR, integer_type_node, + rhs_lt_zero, check_neg, check_pos); + + return emit_check (check, gnu_expr, CE_Overflow_Check_Failed); } -/* Emit code for a range check. GNU_EXPR is the expression to be checked, +/* Emit code for a range check. GNU_EXPR is the expression to be checked, GNAT_RANGE_TYPE the gnat type or subtype containing the bounds against - which we have to check. */ + which we have to check. */ static tree emit_range_check (tree gnu_expr, Entity_Id gnat_range_type) |