X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=gcc%2Fada%2Fgcc-interface%2Ftrans.c;h=84fa13878707a480b923672c336c2aec44053e3b;hb=011149a079e66ec098a92a52498db9d6b2813c7f;hp=7cf15dafb11bc870623fc50cc254632cd40d2d1e;hpb=0bdc5b3830d5e1587056ee90832ee43fb6ff7719;p=pf3gnuchains%2Fgcc-fork.git diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 7cf15dafb11..84fa1387870 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -230,8 +230,9 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED, 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; @@ -317,23 +318,26 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED, 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); @@ -474,7 +478,8 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED, (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))), @@ -496,7 +501,7 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED, 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))), @@ -512,9 +517,7 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED, 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); @@ -1212,7 +1215,7 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) 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) @@ -1354,17 +1357,12 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) 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, - size_diffop (size_zero_node, gnu_pos)); - gnu_byte_offset - = fold_build1 (NEGATE_EXPR, sizetype, gnu_byte_offset); - 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); @@ -1677,7 +1675,7 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) 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)); @@ -2046,6 +2044,46 @@ Case_Statement_to_gnu (Node_Id gnat_node) return gnu_result; } +/* 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. */ @@ -2053,8 +2091,8 @@ static tree 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; @@ -2076,7 +2114,7 @@ Loop_Statement_to_gnu (Node_Id gnat_node) /* 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 @@ -2090,18 +2128,20 @@ Loop_Statement_to_gnu (Node_Id gnat_node) 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 { @@ -2109,25 +2149,118 @@ Loop_Statement_to_gnu (Node_Id gnat_node) 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 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)) + /* 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; + } + + 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 @@ -2143,23 +2276,17 @@ Loop_Statement_to_gnu (Node_Id gnat_node) /* 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, boolean_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); } @@ -2230,7 +2357,7 @@ establish_gnat_vms_condition_handler (void) 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), @@ -3257,7 +3384,7 @@ Exception_Handler_to_gnu_sjlj (Node_Id gnat_node) else this_choice = build_binary_op - (EQ_EXPR, integer_type_node, + (EQ_EXPR, boolean_type_node, convert (integer_type_node, build_component_ref @@ -3284,7 +3411,7 @@ Exception_Handler_to_gnu_sjlj (Node_Id gnat_node) 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))); @@ -3301,8 +3428,8 @@ Exception_Handler_to_gnu_sjlj (Node_Id gnat_node) 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); } @@ -3310,7 +3437,7 @@ Exception_Handler_to_gnu_sjlj (Node_Id gnat_node) 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); } @@ -3541,7 +3668,8 @@ unchecked_conversion_nop (Node_Id gnat_node) 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; @@ -3559,11 +3687,16 @@ unchecked_conversion_nop (Node_Id gnat_node) 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; } @@ -4037,14 +4170,14 @@ gnat_to_gnu (Node_Id gnat_node) 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, @@ -4053,7 +4186,7 @@ gnat_to_gnu (Node_Id gnat_node) /* 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); @@ -4150,21 +4283,20 @@ gnat_to_gnu (Node_Id 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; @@ -4492,7 +4624,7 @@ gnat_to_gnu (Node_Id gnat_node) 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))), @@ -4665,10 +4797,12 @@ gnat_to_gnu (Node_Id 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 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; @@ -5263,17 +5397,12 @@ gnat_to_gnu (Node_Id gnat_node) 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, - size_diffop (size_zero_node, gnu_pos)); - gnu_byte_offset - = fold_build1 (NEGATE_EXPR, sizetype, gnu_byte_offset); - 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 @@ -6001,43 +6130,43 @@ gnat_gimplify_stmt (tree *stmt_p) 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)); @@ -6394,7 +6523,7 @@ build_unary_op_trapv (enum tree_code code, tree gnu_type, tree operand, 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); @@ -6438,8 +6567,8 @@ build_binary_op_trapv (enum tree_code code, tree gnu_type, tree left, } 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) */ @@ -6475,10 +6604,10 @@ build_binary_op_trapv (enum tree_code code, tree gnu_type, tree left, 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); @@ -6501,9 +6630,9 @@ build_binary_op_trapv (enum tree_code code, tree gnu_type, tree left, /* 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); @@ -6514,24 +6643,24 @@ build_binary_op_trapv (enum tree_code code, tree gnu_type, tree left, { 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; @@ -6549,19 +6678,31 @@ build_binary_op_trapv (enum tree_code code, tree gnu_type, tree left, 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: @@ -6575,8 +6716,8 @@ build_binary_op_trapv (enum tree_code code, tree gnu_type, tree left, 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); } @@ -6610,19 +6751,18 @@ emit_range_check (tree gnu_expr, Entity_Id gnat_range_type, Node_Id 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)))), @@ -6659,15 +6799,13 @@ emit_index_check (tree gnu_array_object, tree gnu_expr, tree gnu_low, 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))), @@ -6780,7 +6918,7 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp, : 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))); @@ -6791,9 +6929,9 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp, 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)))); @@ -6851,7 +6989,7 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp, gnu_result = gnat_protect_expr (gnu_result); gnu_conv = convert (calc_type, gnu_result); gnu_comp - = fold_build2 (GE_EXPR, integer_type_node, gnu_result, gnu_zero); + = fold_build2 (GE_EXPR, boolean_type_node, gnu_result, gnu_zero); gnu_add_pred_half = fold_build2 (PLUS_EXPR, calc_type, gnu_conv, gnu_pred_half); gnu_subtract_pred_half