diff options
Diffstat (limited to 'gcc/fortran/trans.c')
| -rw-r--r-- | gcc/fortran/trans.c | 80 |
1 files changed, 53 insertions, 27 deletions
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 073e34f0eb5..5961c267e8c 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -501,6 +501,11 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock, gfc_start_block (&block); + /* For error, runtime_error_at already implies PRED_NORETURN. */ + if (!error && once) + gfc_add_expr_to_block (&block, build_predict_expr (PRED_FORTRAN_WARN_ONCE, + NOT_TAKEN)); + /* The code to generate the error. */ va_start (ap, msgid); gfc_add_expr_to_block (&block, @@ -519,14 +524,12 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock, } else { - /* Tell the compiler that this isn't likely. */ if (once) cond = fold_build2_loc (where->lb->location, TRUTH_AND_EXPR, long_integer_type_node, tmpvar, cond); else cond = fold_convert (long_integer_type_node, cond); - cond = gfc_unlikely (cond); tmp = fold_build3_loc (where->lb->location, COND_EXPR, void_type_node, cond, body, build_empty_stmt (where->lb->location)); @@ -616,7 +619,8 @@ void gfc_allocate_using_malloc (stmtblock_t * block, tree pointer, tree size, tree status) { - tree tmp, on_error, error_cond; + tree tmp, error_cond; + stmtblock_t on_error; tree status_type = status ? TREE_TYPE (status) : NULL_TREE; /* Evaluate size only once, and make sure it has the right type. */ @@ -640,20 +644,31 @@ gfc_allocate_using_malloc (stmtblock_t * block, tree pointer, build_int_cst (size_type_node, 1))))); /* What to do in case of error. */ + gfc_start_block (&on_error); if (status != NULL_TREE) - on_error = fold_build2_loc (input_location, MODIFY_EXPR, status_type, - status, build_int_cst (status_type, LIBERROR_ALLOCATION)); + { + gfc_add_expr_to_block (&on_error, + build_predict_expr (PRED_FORTRAN_FAIL_ALLOC, + NOT_TAKEN)); + tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type, status, + build_int_cst (status_type, LIBERROR_ALLOCATION)); + gfc_add_expr_to_block (&on_error, tmp); + } else - on_error = build_call_expr_loc (input_location, gfor_fndecl_os_error, 1, + { + /* Here, os_error already implies PRED_NORETURN. */ + tmp = build_call_expr_loc (input_location, gfor_fndecl_os_error, 1, gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const - ("Allocation would exceed memory limit"))); + ("Allocation would exceed memory limit"))); + gfc_add_expr_to_block (&on_error, tmp); + } error_cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, pointer, build_int_cst (prvoid_type_node, 0)); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, - gfc_unlikely (error_cond), on_error, + error_cond, gfc_finish_block (&on_error), build_empty_stmt (input_location)); gfc_add_expr_to_block (block, tmp); @@ -750,7 +765,8 @@ gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree token, null_mem = gfc_unlikely (fold_build2_loc (input_location, NE_EXPR, boolean_type_node, mem, - build_int_cst (type, 0))); + build_int_cst (type, 0)), + PRED_FORTRAN_FAIL_ALLOC); /* If mem is NULL, we call gfc_allocate_using_malloc or gfc_allocate_using_lib. */ @@ -770,8 +786,8 @@ gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree token, cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, status, build_zero_cst (TREE_TYPE (status))); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, - gfc_unlikely (cond), tmp, - build_empty_stmt (input_location)); + gfc_unlikely (cond, PRED_FORTRAN_FAIL_ALLOC), + tmp, build_empty_stmt (input_location)); gfc_add_expr_to_block (&alloc_block, tmp); } } @@ -1268,8 +1284,8 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg, status_type, status), build_int_cst (status_type, 0)); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, - gfc_unlikely (cond2), tmp, - build_empty_stmt (input_location)); + gfc_unlikely (cond2, PRED_FORTRAN_FAIL_ALLOC), + tmp, build_empty_stmt (input_location)); gfc_add_expr_to_block (&non_null, tmp); } } @@ -1327,8 +1343,8 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg, cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, stat, build_zero_cst (TREE_TYPE (stat))); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, - gfc_unlikely (cond2), tmp, - build_empty_stmt (input_location)); + gfc_unlikely (cond2, PRED_FORTRAN_FAIL_ALLOC), + tmp, build_empty_stmt (input_location)); gfc_add_expr_to_block (&non_null, tmp); } } @@ -2015,15 +2031,20 @@ gfc_finish_wrapped_block (gfc_wrapped_block* block) /* Helper function for marking a boolean expression tree as unlikely. */ tree -gfc_unlikely (tree cond) +gfc_unlikely (tree cond, enum br_predictor predictor) { tree tmp; - cond = fold_convert (long_integer_type_node, cond); - tmp = build_zero_cst (long_integer_type_node); - cond = build_call_expr_loc (input_location, - builtin_decl_explicit (BUILT_IN_EXPECT), - 2, cond, tmp); + if (optimize) + { + cond = fold_convert (long_integer_type_node, cond); + tmp = build_zero_cst (long_integer_type_node); + cond = build_call_expr_loc (input_location, + builtin_decl_explicit (BUILT_IN_EXPECT), + 3, cond, tmp, + build_int_cst (integer_type_node, + predictor)); + } cond = fold_convert (boolean_type_node, cond); return cond; } @@ -2032,15 +2053,20 @@ gfc_unlikely (tree cond) /* Helper function for marking a boolean expression tree as likely. */ tree -gfc_likely (tree cond) +gfc_likely (tree cond, enum br_predictor predictor) { tree tmp; - cond = fold_convert (long_integer_type_node, cond); - tmp = build_one_cst (long_integer_type_node); - cond = build_call_expr_loc (input_location, - builtin_decl_explicit (BUILT_IN_EXPECT), - 2, cond, tmp); + if (optimize) + { + cond = fold_convert (long_integer_type_node, cond); + tmp = build_one_cst (long_integer_type_node); + cond = build_call_expr_loc (input_location, + builtin_decl_explicit (BUILT_IN_EXPECT), + 3, cond, tmp, + build_int_cst (integer_type_node, + predictor)); + } cond = fold_convert (boolean_type_node, cond); return cond; } |