--- /dev/null
+/****************************************************************************
+ * *
+ * GNAT COMPILER COMPONENTS *
+ * *
+ * A R I T 6 4 . C *
+ * *
+ * C Implementation File *
+ * *
+ * Copyright (C) 2008, Free Software Foundation, Inc. *
+ * *
+ * GNAT is free software; you can redistribute it and/or modify it under *
+ * terms of the GNU General Public License as published by the Free Soft- *
+ * ware Foundation; either version 2, or (at your option) any later ver- *
+ * sion. GNAT is distributed in the hope that it will be useful, but WITH- *
+ * OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *
+ * for more details. You should have received a copy of the GNU General *
+ * Public License distributed with GNAT; see file COPYING. If not, write *
+ * to the Free Software Foundation, 51 Franklin Street, Fifth Floor, *
+ * Boston, MA 02110-1301, USA. *
+ * *
+ * As a special exception, if you link this file with other files to *
+ * produce an executable, this file does not by itself cause the resulting *
+ * executable to be covered by the GNU General Public License. This except- *
+ * ion does not however invalidate any other reasons why the executable *
+ * file might be covered by the GNU Public License. *
+ * *
+ * GNAT was originally developed by the GNAT team at New York University. *
+ * Extensive contributions were provided by Ada Core Technologies Inc. *
+ * *
+ ****************************************************************************/
+
+extern void __gnat_rcheck_10(char *file, int line)
+ __attribute__ ((__noreturn__));
+
+long long int __gnat_mulv64 (long long int x, long long int y)
+{
+ unsigned neg = (x >= 0) ^ (y >= 0);
+ long long unsigned xa = x >= 0 ? (long long unsigned) x
+ : -(long long unsigned) x;
+ long long unsigned ya = y >= 0 ? (long long unsigned) y
+ : -(long long unsigned) y;
+ unsigned xhi = (unsigned) (xa >> 32);
+ unsigned yhi = (unsigned) (ya >> 32);
+ unsigned xlo = (unsigned) xa;
+ unsigned ylo = (unsigned) ya;
+ long long unsigned mid
+ = xhi ? (long long unsigned) xhi * (long long unsigned) ylo
+ : (long long unsigned) yhi * (long long unsigned) xlo;
+ long long unsigned low = (long long unsigned) xlo * (long long unsigned) ylo;
+
+ if ((xhi && yhi) || mid + (low >> 32) > 0x7fffffff + neg)
+ __gnat_rcheck_10 (__FILE__, __LINE__);
+
+ low += ((long long unsigned) (unsigned) mid) << 32;
+
+ return (long long int) (neg ? -low : low);
+}
static tree emit_range_check (tree, Node_Id);
static tree emit_index_check (tree, tree, tree, tree);
static tree emit_check (tree, tree, int);
+static tree build_unary_op_trapv (enum tree_code, tree, tree);
+static tree build_binary_op_trapv (enum tree_code, tree, tree, tree);
static tree convert_with_check (Entity_Id, tree, bool, bool, bool);
static bool smaller_packable_type_p (tree, tree);
static bool addressable_p (tree, tree);
gnu_rhs = convert (gnu_type, gnu_rhs);
}
- gnu_result = build_binary_op (code, gnu_type, gnu_lhs, gnu_rhs);
+ /* Instead of expanding overflow checks for addition, subtraction
+ and multiplication itself, the front end will leave this to
+ the back end when Backend_Overflow_Checks_On_Target is set.
+ As the GCC back end itself does not know yet how to properly
+ do overflow checking, do it here. The goal is to push
+ the expansions further into the back end over time. */
+ if (Do_Overflow_Check (gnat_node) && Backend_Overflow_Checks_On_Target
+ && (Nkind (gnat_node) == N_Op_Add
+ || Nkind (gnat_node) == N_Op_Subtract
+ || Nkind (gnat_node) == N_Op_Multiply)
+ && !TYPE_UNSIGNED (gnu_type)
+ && !FLOAT_TYPE_P (gnu_type))
+ gnu_result
+ = build_binary_op_trapv (code, gnu_type, gnu_lhs, gnu_rhs);
+ else
+ gnu_result = build_binary_op (code, gnu_type, gnu_lhs, gnu_rhs);
/* If this is a logical shift with the shift count not verified,
we must return zero if it is too large. We cannot compensate
gnu_result_type = get_unpadded_type (Base_Type
(Full_View (Etype (gnat_node))));
- gnu_result = build_unary_op (gnu_codes[Nkind (gnat_node)],
- gnu_result_type, gnu_expr);
+ if (Do_Overflow_Check (gnat_node)
+ && !TYPE_UNSIGNED (gnu_result_type)
+ && !FLOAT_TYPE_P (gnu_result_type))
+ gnu_result = build_unary_op_trapv (gnu_codes[Nkind (gnat_node)],
+ gnu_result_type, gnu_expr);
+ else
+ gnu_result = build_unary_op (gnu_codes[Nkind (gnat_node)],
+ gnu_result_type, gnu_expr);
break;
case N_Allocator:
}
}
\f
+/* 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. */
+
+static tree
+build_unary_op_trapv (enum tree_code code,
+ tree gnu_type,
+ tree operand)
+{
+ gcc_assert ((code == NEGATE_EXPR) || (code == ABS_EXPR));
+
+ operand = save_expr (operand);
+
+ return emit_check (build_binary_op (EQ_EXPR, integer_type_node,
+ operand, TYPE_MIN_VALUE (gnu_type)),
+ build_unary_op (code, gnu_type, operand),
+ 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. */
+
+static tree
+build_binary_op_trapv (enum tree_code code,
+ tree gnu_type,
+ tree left,
+ tree right)
+{
+ tree lhs = save_expr (left);
+ tree rhs = save_expr (right);
+ tree type_max = TYPE_MAX_VALUE (gnu_type);
+ tree type_min = TYPE_MIN_VALUE (gnu_type);
+ tree gnu_expr;
+ tree tmp1, tmp2;
+ tree zero = convert (gnu_type, integer_zero_node);
+ tree rhs_ge_zero;
+ tree check_pos;
+ tree check_neg;
+
+ int precision = TYPE_PRECISION (gnu_type);
+
+ /* Prefer a constant rhs to simplify checks */
+
+ if (TREE_CONSTANT (lhs) && !TREE_CONSTANT (rhs)
+ && commutative_tree_code (code))
+ {
+ 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. */
+
+ if (!TREE_CONSTANT (rhs))
+ {
+ int needed_precision = code == MULT_EXPR ? 2 * precision : precision + 1;
+
+ if (code == MULT_EXPR && precision == 64)
+ {
+ return build_call_2_expr (mulv64_decl, lhs, rhs);
+ }
+ else if (needed_precision <= LONG_LONG_TYPE_SIZE)
+ {
+ tree calc_type = gnat_type_for_size (needed_precision, 0);
+ tree result;
+ tree check;
+
+ result = build_binary_op (code, calc_type,
+ convert (calc_type, lhs),
+ convert (calc_type, rhs));
+
+ 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)));
+
+ result = convert (gnu_type, 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);
+
+ switch (code)
+ {
+ case PLUS_EXPR:
+ /* 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 */
+ 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 */
+ 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 */
+ check_neg = build_binary_op (GT_EXPR, integer_type_node, lhs,
+ build_binary_op (PLUS_EXPR, gnu_type,
+ type_max, rhs));
+ break;
+
+ case MULT_EXPR:
+ /* The check here is designed to be efficient if the rhs is constant,
+ Four different check expressions determine wether X * C overflows,
+ depending on C.
+ C == 0 => false
+ C > 0 => X > type_max / C || X < type_min / C
+ C == -1 => X == type_min
+ C < -1 => X > type_min / C || X < type_max / C */
+
+ tmp1 = build_binary_op (TRUNC_DIV_EXPR, gnu_type, type_max, rhs);
+ tmp2 = build_binary_op (TRUNC_DIV_EXPR, gnu_type, type_min, rhs);
+
+ check_pos = build_binary_op (TRUTH_ANDIF_EXPR, integer_type_node,
+ build_binary_op (NE_EXPR, integer_type_node, zero, rhs),
+ build_binary_op (TRUTH_ORIF_EXPR, integer_type_node,
+ build_binary_op (GT_EXPR, integer_type_node, lhs, tmp1),
+ build_binary_op (LT_EXPR, integer_type_node, lhs, tmp2)));
+
+ check_neg = fold_build3 (COND_EXPR, integer_type_node,
+ build_binary_op (EQ_EXPR, integer_type_node, rhs,
+ build_int_cst (gnu_type, -1)),
+ build_binary_op (EQ_EXPR, integer_type_node, lhs, type_min),
+ build_binary_op (TRUTH_ORIF_EXPR, integer_type_node,
+ build_binary_op (GT_EXPR, integer_type_node, lhs, tmp2),
+ build_binary_op (LT_EXPR, integer_type_node, lhs, tmp1)));
+ break;
+
+ default:
+ 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);
+}
+
/* 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. */
OSDN Git Service
