struct Elist_Header *elists_ptr, struct Elmt_Item *elmts_ptr,
struct String_Entry *strings_ptr, Char_Code *string_chars_ptr,
struct List_Header *list_headers_ptr, Nat number_file,
- struct File_Info_Type *file_info_ptr, Entity_Id standard_boolean,
- Entity_Id standard_integer, Entity_Id standard_long_long_float,
+ struct File_Info_Type *file_info_ptr,
+ Entity_Id standard_boolean, Entity_Id standard_integer,
+ Entity_Id standard_character, Entity_Id standard_long_long_float,
Entity_Id standard_exception_type, Int gigi_operating_mode)
{
Entity_Id gnat_literal;
double_float_alignment = get_target_double_float_alignment ();
double_scalar_alignment = get_target_double_scalar_alignment ();
- /* Record the builtin types. Define `integer' and `unsigned char' first so
- that dbx will output them first. */
+ /* Record the builtin types. Define `integer' and `character' first so that
+ dbx will output them first. */
record_builtin_type ("integer", integer_type_node);
- record_builtin_type ("unsigned char", char_type_node);
- record_builtin_type ("long integer", long_integer_type_node);
- unsigned_type_node = gnat_type_for_size (INT_TYPE_SIZE, 1);
- record_builtin_type ("unsigned int", unsigned_type_node);
- record_builtin_type (SIZE_TYPE, sizetype);
+ record_builtin_type ("character", unsigned_char_type_node);
record_builtin_type ("boolean", boolean_type_node);
record_builtin_type ("void", void_type_node);
/* Save the type we made for integer as the type for Standard.Integer. */
- save_gnu_tree (Base_Type (standard_integer), TYPE_NAME (integer_type_node),
+ save_gnu_tree (Base_Type (standard_integer),
+ TYPE_NAME (integer_type_node),
false);
- /* Save the type we made for boolean as the type for Standard.Boolean. */
- save_gnu_tree (Base_Type (standard_boolean), TYPE_NAME (boolean_type_node),
+ /* Likewise for character as the type for Standard.Character. */
+ save_gnu_tree (Base_Type (standard_character),
+ TYPE_NAME (unsigned_char_type_node),
+ false);
+
+ /* Likewise for boolean as the type for Standard.Boolean. */
+ save_gnu_tree (Base_Type (standard_boolean),
+ TYPE_NAME (boolean_type_node),
false);
gnat_literal = First_Literal (Base_Type (standard_boolean));
t = UI_To_gnu (Enumeration_Rep (gnat_literal), boolean_type_node);
(get_identifier ("__gnat_last_chance_handler"), NULL_TREE,
build_function_type (void_type_node,
tree_cons (NULL_TREE,
- build_pointer_type (char_type_node),
+ build_pointer_type
+ (unsigned_char_type_node),
tree_cons (NULL_TREE,
integer_type_node,
t))),
build_function_type (void_type_node,
tree_cons (NULL_TREE,
build_pointer_type
- (char_type_node),
+ (unsigned_char_type_node),
tree_cons (NULL_TREE,
integer_type_node,
t))),
TYPE_QUAL_VOLATILE);
}
- /* Set the types that GCC and Gigi use from the front end. We would
- like to do this for char_type_node, but it needs to correspond to
- the C char type. */
+ /* Set the types that GCC and Gigi use from the front end. */
exception_type
= gnat_to_gnu_entity (Base_Type (standard_exception_type), NULL_TREE, 0);
except_type_node = TREE_TYPE (exception_type);
for (j = 0; j < TARGET_VTABLE_USES_DESCRIPTORS; j++)
{
- tree field = create_field_decl (NULL_TREE, ptr_void_ftype,
- fdesc_type_node, 0, 0, 0, 1);
+ tree field
+ = create_field_decl (NULL_TREE, ptr_void_ftype, fdesc_type_node,
+ NULL_TREE, NULL_TREE, 0, 1);
TREE_CHAIN (field) = field_list;
field_list = field;
null_list = tree_cons (field, null_node, null_list);
gnu_expr = gnat_protect_expr (gnu_expr);
gnu_expr
= emit_check
- (build_binary_op (EQ_EXPR, integer_type_node,
+ (build_binary_op (EQ_EXPR, boolean_type_node,
gnu_expr,
attribute == Attr_Pred
? TYPE_MIN_VALUE (gnu_result_type)
if (TREE_CODE (gnu_obj_type) == RECORD_TYPE
&& TYPE_CONTAINS_TEMPLATE_P (gnu_obj_type))
{
- tree gnu_char_ptr_type = build_pointer_type (char_type_node);
+ tree gnu_char_ptr_type
+ = build_pointer_type (unsigned_char_type_node);
tree gnu_pos = byte_position (TYPE_FIELDS (gnu_obj_type));
tree gnu_byte_offset
= convert (sizetype,
gnu_ptr = convert (gnu_char_ptr_type, gnu_ptr);
gnu_ptr = build_binary_op (POINTER_PLUS_EXPR, gnu_char_ptr_type,
- gnu_ptr, gnu_byte_offset);
+ gnu_ptr, gnu_pos);
}
gnu_result = convert (gnu_result_type, gnu_ptr);
gnu_type
= build_unc_object_type_from_ptr (gnu_ptr_type,
gnu_actual_obj_type,
- get_identifier ("SIZE"));
+ get_identifier ("SIZE"),
+ false);
}
gnu_result = TYPE_SIZE (gnu_type);
gnu_result
= build_cond_expr (comp_type,
build_binary_op (GE_EXPR,
- integer_type_node,
+ boolean_type_node,
hb, lb),
gnu_result,
convert (comp_type, integer_zero_node));
return gnu_result;
}
\f
+/* Return true if VAL (of type TYPE) can equal the minimum value if MAX is
+ false, or the maximum value if MAX is true, of TYPE. */
+
+static bool
+can_equal_min_or_max_val_p (tree val, tree type, bool max)
+{
+ tree min_or_max_val = (max ? TYPE_MAX_VALUE (type) : TYPE_MIN_VALUE (type));
+
+ if (TREE_CODE (min_or_max_val) != INTEGER_CST)
+ return true;
+
+ if (TREE_CODE (val) == NOP_EXPR)
+ val = (max
+ ? TYPE_MAX_VALUE (TREE_TYPE (TREE_OPERAND (val, 0)))
+ : TYPE_MIN_VALUE (TREE_TYPE (TREE_OPERAND (val, 0))));
+
+ if (TREE_CODE (val) != INTEGER_CST)
+ return true;
+
+ return tree_int_cst_equal (val, min_or_max_val) == 1;
+}
+
+/* Return true if VAL (of type TYPE) can equal the minimum value of TYPE.
+ If REVERSE is true, minimum value is taken as maximum value. */
+
+static inline bool
+can_equal_min_val_p (tree val, tree type, bool reverse)
+{
+ return can_equal_min_or_max_val_p (val, type, reverse);
+}
+
+/* Return true if VAL (of type TYPE) can equal the maximum value of TYPE.
+ If REVERSE is true, maximum value is taken as minimum value. */
+
+static inline bool
+can_equal_max_val_p (tree val, tree type, bool reverse)
+{
+ return can_equal_min_or_max_val_p (val, type, !reverse);
+}
+
/* Subroutine of gnat_to_gnu to translate gnat_node, an N_Loop_Statement,
to a GCC tree, which is returned. */
Loop_Statement_to_gnu (Node_Id gnat_node)
{
const Node_Id gnat_iter_scheme = Iteration_Scheme (gnat_node);
- tree gnu_loop_stmt = build5 (LOOP_STMT, void_type_node, NULL_TREE,
- NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE);
+ tree gnu_loop_stmt = build4 (LOOP_STMT, void_type_node, NULL_TREE,
+ NULL_TREE, NULL_TREE, NULL_TREE);
tree gnu_loop_label = create_artificial_label (input_location);
tree gnu_loop_var = NULL_TREE, gnu_cond_expr = NULL_TREE;
tree gnu_result;
/* For the case "WHILE condition LOOP ..... END LOOP;" it's immediate. */
else if (Present (Condition (gnat_iter_scheme)))
- LOOP_STMT_TOP_COND (gnu_loop_stmt)
+ LOOP_STMT_COND (gnu_loop_stmt)
= gnat_to_gnu (Condition (gnat_iter_scheme));
/* Otherwise we have an iteration scheme and the condition is given by the
tree gnu_low = TYPE_MIN_VALUE (gnu_type);
tree gnu_high = TYPE_MAX_VALUE (gnu_type);
tree gnu_base_type = get_base_type (gnu_type);
- tree gnu_first, gnu_last, gnu_limit, gnu_test;
- enum tree_code update_code, test_code;
+ tree gnu_one_node = convert (gnu_base_type, integer_one_node);
+ tree gnu_first, gnu_last;
+ enum tree_code update_code, test_code, shift_code;
+ bool reverse = Reverse_Present (gnat_loop_spec), fallback = false;
/* We must disable modulo reduction for the iteration variable, if any,
in order for the loop comparison to be effective. */
- if (Reverse_Present (gnat_loop_spec))
+ if (reverse)
{
gnu_first = gnu_high;
gnu_last = gnu_low;
update_code = MINUS_NOMOD_EXPR;
test_code = GE_EXPR;
- gnu_limit = TYPE_MIN_VALUE (gnu_base_type);
+ shift_code = PLUS_NOMOD_EXPR;
}
else
{
gnu_last = gnu_high;
update_code = PLUS_NOMOD_EXPR;
test_code = LE_EXPR;
- gnu_limit = TYPE_MAX_VALUE (gnu_base_type);
+ shift_code = MINUS_NOMOD_EXPR;
+ }
+
+ /* We use two different strategies to translate the loop, depending on
+ whether optimization is enabled.
+
+ If it is, we try to generate the canonical form of loop expected by
+ the loop optimizer, which is the do-while form:
+
+ ENTRY_COND
+ loop:
+ TOP_UPDATE
+ BODY
+ BOTTOM_COND
+ GOTO loop
+
+ This makes it possible to bypass loop header copying and to turn the
+ BOTTOM_COND into an inequality test. This should catch (almost) all
+ loops with constant starting point. If we cannot, we try to generate
+ the default form, which is:
+
+ loop:
+ TOP_COND
+ BODY
+ BOTTOM_UPDATE
+ GOTO loop
+
+ It will be rotated during loop header copying and an entry test added
+ to yield the do-while form. This should catch (almost) all loops with
+ constant ending point. If we cannot, we generate the fallback form:
+
+ ENTRY_COND
+ loop:
+ BODY
+ BOTTOM_COND
+ BOTTOM_UPDATE
+ GOTO loop
+
+ which works in all cases but for which loop header copying will copy
+ the BOTTOM_COND, thus adding a third conditional branch.
+
+ If optimization is disabled, loop header copying doesn't come into
+ play and we try to generate the loop forms with the less conditional
+ branches directly. First, the default form, it should catch (almost)
+ all loops with constant ending point. Then, if we cannot, we try to
+ generate the shifted form:
+
+ loop:
+ TOP_COND
+ TOP_UPDATE
+ BODY
+ GOTO loop
+
+ which should catch loops with constant starting point. Otherwise, if
+ we cannot, we generate the fallback form. */
+
+ if (optimize)
+ {
+ /* We can use the do-while form if GNU_FIRST-1 doesn't overflow. */
+ if (!can_equal_min_val_p (gnu_first, gnu_base_type, reverse))
+ {
+ gnu_first = build_binary_op (shift_code, gnu_base_type,
+ gnu_first, gnu_one_node);
+ LOOP_STMT_TOP_UPDATE_P (gnu_loop_stmt) = 1;
+ LOOP_STMT_BOTTOM_COND_P (gnu_loop_stmt) = 1;
+ }
+
+ /* Otherwise, we can use the default form if GNU_LAST+1 doesn't. */
+ else if (!can_equal_max_val_p (gnu_last, gnu_base_type, reverse))
+ ;
+
+ /* Otherwise, use the fallback form. */
+ else
+ fallback = true;
+ }
+ else
+ {
+ /* We can use the default form if GNU_LAST+1 doesn't overflow. */
+ if (!can_equal_max_val_p (gnu_last, gnu_base_type, reverse))
+ ;
+
+ /* Otherwise, we can use the shifted form if neither GNU_FIRST-1 nor
+ GNU_LAST-1 does. */
+ else if (!can_equal_min_val_p (gnu_first, gnu_base_type, reverse)
+ && !can_equal_min_val_p (gnu_last, gnu_base_type, reverse))
+ {
+ gnu_first = build_binary_op (shift_code, gnu_base_type,
+ gnu_first, gnu_one_node);
+ gnu_last = build_binary_op (shift_code, gnu_base_type,
+ gnu_last, gnu_one_node);
+ LOOP_STMT_TOP_UPDATE_P (gnu_loop_stmt) = 1;
+ }
+
+ /* Otherwise, use the fallback form. */
+ else
+ fallback = true;
}
- /* We know that the iteration variable will not overflow if GNU_LAST is
- a constant and is not equal to GNU_LIMIT. If it might overflow, we
- have to turn the limit test into an inequality test and move it to
- the end of the loop; as a consequence, we also have to test for an
- empty loop before entering it. */
- if (TREE_CODE (gnu_last) != INTEGER_CST
- || TREE_CODE (gnu_limit) != INTEGER_CST
- || tree_int_cst_equal (gnu_last, gnu_limit))
+ if (fallback)
+ LOOP_STMT_BOTTOM_COND_P (gnu_loop_stmt) = 1;
+
+ /* If we use the BOTTOM_COND, we can turn the test into an inequality
+ test but we have to add an ENTRY_COND to protect the empty loop. */
+ if (LOOP_STMT_BOTTOM_COND_P (gnu_loop_stmt))
{
+ test_code = NE_EXPR;
gnu_cond_expr
= build3 (COND_EXPR, void_type_node,
- build_binary_op (LE_EXPR, integer_type_node,
+ build_binary_op (LE_EXPR, boolean_type_node,
gnu_low, gnu_high),
NULL_TREE, alloc_stmt_list ());
set_expr_location_from_node (gnu_cond_expr, gnat_loop_spec);
- test_code = NE_EXPR;
}
/* Open a new nesting level that will surround the loop to declare the
/* Do all the arithmetics in the base type. */
gnu_loop_var = convert (gnu_base_type, gnu_loop_var);
- /* Set either the top or bottom exit condition as appropriate depending
- on whether or not we know an overflow cannot occur. */
- gnu_test = build_binary_op (test_code, integer_type_node, gnu_loop_var,
- gnu_last);
- if (gnu_cond_expr)
- LOOP_STMT_BOT_COND (gnu_loop_stmt) = gnu_test;
- else
- LOOP_STMT_TOP_COND (gnu_loop_stmt) = gnu_test;
+ /* Set either the top or bottom exit condition. */
+ LOOP_STMT_COND (gnu_loop_stmt)
+ = build_binary_op (test_code, integer_type_node, gnu_loop_var,
+ gnu_last);
+ /* Set either the top or bottom update statement and give it the source
+ location of the iteration for better coverage info. */
LOOP_STMT_UPDATE (gnu_loop_stmt)
- = build_binary_op (MODIFY_EXPR, NULL_TREE,
- gnu_loop_var,
- build_binary_op (update_code,
- TREE_TYPE (gnu_loop_var),
- gnu_loop_var,
- convert (TREE_TYPE (gnu_loop_var),
- integer_one_node)));
+ = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_loop_var,
+ build_binary_op (update_code, gnu_base_type,
+ gnu_loop_var, gnu_one_node));
set_expr_location_from_node (LOOP_STMT_UPDATE (gnu_loop_stmt),
gnat_iter_scheme);
}
gnat_vms_condition_handler_decl
= create_subprog_decl (get_identifier ("__gnat_handle_vms_condition"),
NULL_TREE,
- build_function_type_list (integer_type_node,
+ build_function_type_list (boolean_type_node,
ptr_void_type_node,
ptr_void_type_node,
NULL_TREE),
tree gnu_subprog_addr = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_subprog);
Entity_Id gnat_formal;
Node_Id gnat_actual;
- tree gnu_actual_list = NULL_TREE;
+ VEC(tree,gc) *gnu_actual_vec = NULL;
tree gnu_name_list = NULL_TREE;
tree gnu_before_list = NULL_TREE;
tree gnu_after_list = NULL_TREE;
gnu_actual = convert (DECL_ARG_TYPE (gnu_formal), gnu_actual);
}
- gnu_actual_list = tree_cons (NULL_TREE, gnu_actual, gnu_actual_list);
+ VEC_safe_push (tree, gc, gnu_actual_vec, gnu_actual);
}
gnu_call = build_call_list (TREE_TYPE (gnu_subprog_type), gnu_subprog_addr,
else
this_choice
= build_binary_op
- (EQ_EXPR, integer_type_node,
+ (EQ_EXPR, boolean_type_node,
convert
(integer_type_node,
build_component_ref
this_choice
= build_binary_op
- (EQ_EXPR, integer_type_node, TREE_VALUE (gnu_except_ptr_stack),
+ (EQ_EXPR, boolean_type_node, TREE_VALUE (gnu_except_ptr_stack),
convert (TREE_TYPE (TREE_VALUE (gnu_except_ptr_stack)),
build_unary_op (ADDR_EXPR, NULL_TREE, gnu_expr)));
this_choice
= build_binary_op
- (TRUTH_ORIF_EXPR, integer_type_node,
- build_binary_op (EQ_EXPR, integer_type_node, gnu_comp,
+ (TRUTH_ORIF_EXPR, boolean_type_node,
+ build_binary_op (EQ_EXPR, boolean_type_node, gnu_comp,
build_int_cst (TREE_TYPE (gnu_comp), 'V')),
this_choice);
}
else
gcc_unreachable ();
- gnu_choice = build_binary_op (TRUTH_ORIF_EXPR, integer_type_node,
+ gnu_choice = build_binary_op (TRUTH_ORIF_EXPR, boolean_type_node,
gnu_choice, this_choice);
}
start_stmt_group ();
gnat_pushlevel ();
+ current_function_decl = NULL_TREE;
+
+ start_stmt_group ();
+ gnat_pushlevel ();
+
/* For a body, first process the spec if there is one. */
if (Nkind (Unit (gnat_node)) == N_Package_Body
|| (Nkind (Unit (gnat_node)) == N_Subprogram_Body
could de facto ensure type consistency and this should be preserved. */
if (!(Nkind (Parent (gnat_node)) == N_Assignment_Statement
&& Name (Parent (gnat_node)) == gnat_node)
- && !(Nkind (Parent (gnat_node)) == N_Procedure_Call_Statement
+ && !((Nkind (Parent (gnat_node)) == N_Procedure_Call_Statement
+ || Nkind (Parent (gnat_node)) == N_Function_Call)
&& Name (Parent (gnat_node)) != gnat_node))
return false;
if (to_type == from_type)
return true;
- /* For an array type, the conversion to the PAT is a no-op. */
+ /* For an array subtype, the conversion to the PAT is a no-op. */
if (Ekind (from_type) == E_Array_Subtype
&& to_type == Packed_Array_Type (from_type))
return true;
+ /* For a record subtype, the conversion to the type is a no-op. */
+ if (Ekind (from_type) == E_Record_Subtype
+ && to_type == Etype (from_type))
+ return true;
+
return false;
}
gnu_expr_type = get_base_type (gnu_index_type);
/* Test whether the minimum slice value is too small. */
- gnu_expr_l = build_binary_op (LT_EXPR, integer_type_node,
+ gnu_expr_l = build_binary_op (LT_EXPR, boolean_type_node,
convert (gnu_expr_type,
gnu_min_expr),
convert (gnu_expr_type,
gnu_base_min_expr));
/* Test whether the maximum slice value is too large. */
- gnu_expr_h = build_binary_op (GT_EXPR, integer_type_node,
+ gnu_expr_h = build_binary_op (GT_EXPR, boolean_type_node,
convert (gnu_expr_type,
gnu_max_expr),
convert (gnu_expr_type,
/* Build a slice index check that returns the low bound,
assuming the slice is not empty. */
gnu_expr = emit_check
- (build_binary_op (TRUTH_ORIF_EXPR, integer_type_node,
+ (build_binary_op (TRUTH_ORIF_EXPR, boolean_type_node,
gnu_expr_l, gnu_expr_h),
gnu_min_expr, CE_Index_Check_Failed, gnat_node);
case N_Attribute_Reference:
{
- /* The attribute designator (like an enumeration value). */
- int attribute = Get_Attribute_Id (Attribute_Name (gnat_node));
-
- /* The Elab_Spec and Elab_Body attributes are special in that
- Prefix is a unit, not an object with a GCC equivalent. Similarly
- for Elaborated, since that variable isn't otherwise known. */
- if (attribute == Attr_Elab_Body || attribute == Attr_Elab_Spec)
- return (create_subprog_decl
- (create_concat_name (Entity (Prefix (gnat_node)),
- attribute == Attr_Elab_Body
- ? "elabb" : "elabs"),
- NULL_TREE, void_ftype, NULL_TREE, false, true, true, NULL,
- gnat_node));
-
- gnu_result = Attribute_to_gnu (gnat_node, &gnu_result_type, attribute);
+ /* The attribute designator. */
+ const int attr = Get_Attribute_Id (Attribute_Name (gnat_node));
+
+ /* The Elab_Spec and Elab_Body attributes are special in that Prefix
+ is a unit, not an object with a GCC equivalent. */
+ if (attr == Attr_Elab_Spec || attr == Attr_Elab_Body)
+ return
+ create_subprog_decl (create_concat_name
+ (Entity (Prefix (gnat_node)),
+ attr == Attr_Elab_Body ? "elabb" : "elabs"),
+ NULL_TREE, void_ftype, NULL_TREE, false,
+ true, true, NULL, gnat_node);
+
+ gnu_result = Attribute_to_gnu (gnat_node, &gnu_result_type, attr);
}
break;
gnu_result
= build_cond_expr
(gnu_type,
- build_binary_op (GE_EXPR, integer_type_node,
+ build_binary_op (GE_EXPR, boolean_type_node,
gnu_rhs,
convert (TREE_TYPE (gnu_rhs),
TYPE_SIZE (gnu_type))),
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 the type being assigned is an array type and the two sides are
+ not completely disjoint, play safe and use memmove. But don't do
+ it for a bit-packed array as it might not be byte-aligned. */
if (TREE_CODE (gnu_result) == MODIFY_EXPR
&& Is_Array_Type (Etype (Name (gnat_node)))
+ && !Is_Bit_Packed_Array (Etype (Name (gnat_node)))
&& !(Forwards_OK (gnat_node) && Backwards_OK (gnat_node)))
{
tree to, from, size, to_ptr, from_ptr, t;
if (TREE_CODE (gnu_obj_type) == RECORD_TYPE
&& TYPE_CONTAINS_TEMPLATE_P (gnu_obj_type))
{
- tree gnu_char_ptr_type = build_pointer_type (char_type_node);
+ tree gnu_char_ptr_type
+ = build_pointer_type (unsigned_char_type_node);
tree gnu_pos = byte_position (TYPE_FIELDS (gnu_obj_type));
tree gnu_byte_offset
= convert (sizetype,
gnu_ptr = convert (gnu_char_ptr_type, gnu_ptr);
gnu_ptr = build_binary_op (POINTER_PLUS_EXPR, gnu_char_ptr_type,
- gnu_ptr, gnu_byte_offset);
+ gnu_ptr, gnu_pos);
}
gnu_result
case LOOP_STMT:
{
tree gnu_start_label = create_artificial_label (input_location);
+ tree gnu_cond = LOOP_STMT_COND (stmt);
+ tree gnu_update = LOOP_STMT_UPDATE (stmt);
tree gnu_end_label = LOOP_STMT_LABEL (stmt);
tree t;
+ /* Build the condition expression from the test, if any. */
+ if (gnu_cond)
+ gnu_cond
+ = build3 (COND_EXPR, void_type_node, gnu_cond, alloc_stmt_list (),
+ build1 (GOTO_EXPR, void_type_node, gnu_end_label));
+
/* Set to emit the statements of the loop. */
*stmt_p = NULL_TREE;
- /* We first emit the start label and then a conditional jump to
- the end label if there's a top condition, then the body of the
- loop, then a conditional branch to the end label, then the update,
- if any, and finally a jump to the start label and the definition
- of the end label. */
+ /* We first emit the start label and then a conditional jump to the
+ end label if there's a top condition, then the update if it's at
+ the top, then the body of the loop, then a conditional jump to
+ the end label if there's a bottom condition, then the update if
+ it's at the bottom, and finally a jump to the start label and the
+ definition of the end label. */
append_to_statement_list (build1 (LABEL_EXPR, void_type_node,
gnu_start_label),
stmt_p);
- if (LOOP_STMT_TOP_COND (stmt))
- append_to_statement_list (build3 (COND_EXPR, void_type_node,
- LOOP_STMT_TOP_COND (stmt),
- alloc_stmt_list (),
- build1 (GOTO_EXPR,
- void_type_node,
- gnu_end_label)),
- stmt_p);
+ if (gnu_cond && !LOOP_STMT_BOTTOM_COND_P (stmt))
+ append_to_statement_list (gnu_cond, stmt_p);
+
+ if (gnu_update && LOOP_STMT_TOP_UPDATE_P (stmt))
+ append_to_statement_list (gnu_update, stmt_p);
append_to_statement_list (LOOP_STMT_BODY (stmt), stmt_p);
- if (LOOP_STMT_BOT_COND (stmt))
- append_to_statement_list (build3 (COND_EXPR, void_type_node,
- LOOP_STMT_BOT_COND (stmt),
- alloc_stmt_list (),
- build1 (GOTO_EXPR,
- void_type_node,
- gnu_end_label)),
- stmt_p);
+ if (gnu_cond && LOOP_STMT_BOTTOM_COND_P (stmt))
+ append_to_statement_list (gnu_cond, stmt_p);
- if (LOOP_STMT_UPDATE (stmt))
- append_to_statement_list (LOOP_STMT_UPDATE (stmt), stmt_p);
+ if (gnu_update && !LOOP_STMT_TOP_UPDATE_P (stmt))
+ append_to_statement_list (gnu_update, stmt_p);
t = build1 (GOTO_EXPR, void_type_node, gnu_start_label);
SET_EXPR_LOCATION (t, DECL_SOURCE_LOCATION (gnu_end_label));
operand = gnat_protect_expr (operand);
- return emit_check (build_binary_op (EQ_EXPR, integer_type_node,
+ return emit_check (build_binary_op (EQ_EXPR, boolean_type_node,
operand, TYPE_MIN_VALUE (gnu_type)),
build_unary_op (code, gnu_type, operand),
CE_Overflow_Check_Failed, gnat_node);
}
rhs_lt_zero = tree_expr_nonnegative_p (rhs)
- ? integer_zero_node
- : build_binary_op (LT_EXPR, integer_type_node, rhs, zero);
+ ? boolean_false_node
+ : build_binary_op (LT_EXPR, boolean_type_node, rhs, zero);
/* ??? Should use more efficient check for operand_equal_p (lhs, rhs, 0) */
convert (wide_type, rhs));
tree check = build_binary_op
- (TRUTH_ORIF_EXPR, integer_type_node,
- build_binary_op (LT_EXPR, integer_type_node, wide_result,
+ (TRUTH_ORIF_EXPR, boolean_type_node,
+ build_binary_op (LT_EXPR, boolean_type_node, wide_result,
convert (wide_type, type_min)),
- build_binary_op (GT_EXPR, integer_type_node, wide_result,
+ build_binary_op (GT_EXPR, boolean_type_node, wide_result,
convert (wide_type, type_max)));
tree result = convert (gnu_type, wide_result);
/* 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,
+ (TRUTH_XOR_EXPR, boolean_type_node, rhs_lt_zero,
build_binary_op (code == PLUS_EXPR ? LT_EXPR : GT_EXPR,
- integer_type_node, wrapped_expr, lhs));
+ boolean_type_node, wrapped_expr, lhs));
return
emit_check (check, result, CE_Overflow_Check_Failed, gnat_node);
{
case PLUS_EXPR:
/* When rhs >= 0, overflow when lhs > type_max - rhs. */
- check_pos = build_binary_op (GT_EXPR, integer_type_node, lhs,
+ check_pos = build_binary_op (GT_EXPR, boolean_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,
+ check_neg = build_binary_op (LT_EXPR, boolean_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,
+ check_pos = build_binary_op (LT_EXPR, boolean_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,
+ check_neg = build_binary_op (GT_EXPR, boolean_type_node, lhs,
build_binary_op (PLUS_EXPR, gnu_type,
type_max, rhs));
break;
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)));
+ check_pos
+ = build_binary_op (TRUTH_ANDIF_EXPR, boolean_type_node,
+ build_binary_op (NE_EXPR, boolean_type_node, zero,
+ rhs),
+ build_binary_op (TRUTH_ORIF_EXPR, boolean_type_node,
+ build_binary_op (GT_EXPR,
+ boolean_type_node,
+ lhs, tmp1),
+ build_binary_op (LT_EXPR,
+ boolean_type_node,
+ lhs, tmp2)));
+
+ check_neg
+ = fold_build3 (COND_EXPR, boolean_type_node,
+ build_binary_op (EQ_EXPR, boolean_type_node, rhs,
+ build_int_cst (gnu_type, -1)),
+ build_binary_op (EQ_EXPR, boolean_type_node, lhs,
+ type_min),
+ build_binary_op (TRUTH_ORIF_EXPR, boolean_type_node,
+ build_binary_op (GT_EXPR,
+ boolean_type_node,
+ lhs, tmp2),
+ build_binary_op (LT_EXPR,
+ boolean_type_node,
+ lhs, tmp1)));
break;
default:
if (TREE_CONSTANT (gnu_expr))
return gnu_expr;
- check = fold_build3 (COND_EXPR, integer_type_node,
- rhs_lt_zero, check_neg, check_pos);
+ check = fold_build3 (COND_EXPR, boolean_type_node, rhs_lt_zero, check_neg,
+ check_pos);
return emit_check (check, gnu_expr, CE_Overflow_Check_Failed, gnat_node);
}
/* Checked expressions must be evaluated only once. */
gnu_expr = gnat_protect_expr (gnu_expr);
- /* There's no good type to use here, so we might as well use
- integer_type_node. Note that the form of the check is
+ /* Note that the form of the check is
(not (expr >= lo)) or (not (expr <= hi))
the reason for this slightly convoluted form is that NaNs
are not considered to be in range in the float case. */
return emit_check
- (build_binary_op (TRUTH_ORIF_EXPR, integer_type_node,
+ (build_binary_op (TRUTH_ORIF_EXPR, boolean_type_node,
invert_truthvalue
- (build_binary_op (GE_EXPR, integer_type_node,
+ (build_binary_op (GE_EXPR, boolean_type_node,
convert (gnu_compare_type, gnu_expr),
convert (gnu_compare_type, gnu_low))),
invert_truthvalue
- (build_binary_op (LE_EXPR, integer_type_node,
+ (build_binary_op (LE_EXPR, boolean_type_node,
convert (gnu_compare_type, gnu_expr),
convert (gnu_compare_type,
gnu_high)))),
gnu_low = SUBSTITUTE_PLACEHOLDER_IN_EXPR (gnu_low, gnu_array_object);
gnu_high = SUBSTITUTE_PLACEHOLDER_IN_EXPR (gnu_high, gnu_array_object);
- /* There's no good type to use here, so we might as well use
- integer_type_node. */
return emit_check
- (build_binary_op (TRUTH_ORIF_EXPR, integer_type_node,
- build_binary_op (LT_EXPR, integer_type_node,
+ (build_binary_op (TRUTH_ORIF_EXPR, boolean_type_node,
+ build_binary_op (LT_EXPR, boolean_type_node,
gnu_expr_check,
convert (TREE_TYPE (gnu_expr_check),
gnu_low)),
- build_binary_op (GT_EXPR, integer_type_node,
+ build_binary_op (GT_EXPR, boolean_type_node,
gnu_expr_check,
convert (TREE_TYPE (gnu_expr_check),
gnu_high))),
: 1))
gnu_cond
= invert_truthvalue
- (build_binary_op (GE_EXPR, integer_type_node,
+ (build_binary_op (GE_EXPR, boolean_type_node,
gnu_input, convert (gnu_in_basetype,
gnu_out_lb)));
TREE_REAL_CST (gnu_in_lb))
: 1))
gnu_cond
- = build_binary_op (TRUTH_ORIF_EXPR, integer_type_node, gnu_cond,
+ = build_binary_op (TRUTH_ORIF_EXPR, boolean_type_node, gnu_cond,
invert_truthvalue
- (build_binary_op (LE_EXPR, integer_type_node,
+ (build_binary_op (LE_EXPR, boolean_type_node,
gnu_input,
convert (gnu_in_basetype,
gnu_out_ub))));
OSDN Git Service
