Pre-remark: I currently get Stage 2/Stage 3 miscompares. As this is
unlikely to be caused by my patch, it properly means that Honza's patch
bitrotted even though it still applies.
Dear all,
attached is an updated patch set for this PR.
Background: gfortran uses internally __builtin_expect. However, it
recently changed from very likely (99%, if I recall correctly) to 90%
(adaptable via a "--param"). As side-effect, some conditions for error
paths in gfortran became more likely - even if they lead to no-return
code as PRED_NORETURN is overridden by an explicit __builtin_expect
(alias PRED_BUILTIN_EXPECT).
I have attached two patches:
a) Honza's patch, which he attached to the PR. (without changelog,
rediffed - which essentially means that I have taken out the failing
part, which seems to be already applied.)
b) An updated patch of mine.
Honza's patch permits to add, optionally, a PRED_* value to builtin_predict.
My patch adds a bunch of PRED_* for Fortran, which should cover all
existing use of builtin_expect; I have added a PRED_ for every different
use I found. The PRED_* numbers I use are hopefully good guesses but I
am open for suggestions for their numbers. Additional, one can argue
whether the PRED_* names are well chosen or whether there are too many
PRED_.
On the Fortran side, I have replaced the builtin_expect by either
build_predict_expr (which is added to the (basic) block which is
(un)likely) and by the three-argument version of builtin_expect as we
often use it like "(cont1 || builtin_expect(...))" which isn't
representable with build_predict_expr. (However, I might have used
build_predict_expr in some additional cases.)
The patch was attempted to be bootstrapped on x86-64-gnu-linux.
Tobias
Am 15.12.2013 23:15, schrieb Jan Hubicka:
Jan Hubicka wrote:
Yep, they should not roduce incorrect code. Isn't the problem
that you expect the whole expression to have value and predit_expr
"reutrns" nothing?
Can you check what lands into gimple?
That could well be the case – I replace "0" by "{ built_predict; 0
}" and I wouldn't be surprised if the built_predict causes problem
Yep, though this is also the case whrere you really want to predict
a value rather than code path, so the extended bultin_expect is probably
only resonable approach here.
I am not really generic person, but perhaps it is a difference in between {
built_predict; 0 } that is stmt with no value and built_predict,0 that is an
expression with value?
I will look into the builtin_expect extension. Then we can probably
keem gfc_likely/unlikely with extra argument specifying the predictor
for cases like this and use predict_expr in cases where you
really produce runtime conditional like
if (...)
{ bulitin_predict; abort ();}
Honza
as it returns 'nothing'. At least the basic block belonging to
"else" (<D.1934>) is empty:
Original dump (4.8 and 4.9 with predict patch):
sub1 (&v[S.0 + -1], (logical(kind=4)) __builtin_expect
((integer(kind=8)) (D.1897 == 0B), 0) ? 0B : &(*D.1897)[(S.0 +
D.1901) * D.1903 + D.1898]);
and
sub1 (&v[S.0 + -1], D.1917 != 0B ? &(*D.1917)[(S.0 +
D.1921) * D.1923 + D.1918] : (void) 0);
Gimple of 4.8:
if (D.1916 != 0) goto <D.1917>; else goto <D.1918>;
<D.1917>:
iftmp.2 = 0B;
goto <D.1919>;
<D.1918>:
...
iftmp.2 = &*D.1897[D.1922];
<D.1919>:
..
sub1 (D.1924, iftmp.2);
gimple of 4.9 with patch:
if (D.1917 != 0B) goto <D.1933>; else goto <D.1934>;
<D.1933>:
D.1935 = S.0 + D.1921;
D.1936 = D.1935 * D.1923;
D.1937 = D.1936 + D.1918;
iftmp.2 = &*D.1917[D.1937];
goto <D.1938>;
<D.1934>:
<D.1938>:
D.1939 = S.0 + -1;
D.1940 = &v[D.1939];
sub1 (D.1940, iftmp.2);
Tobias
PS: That's for the code:
implicit none
type t2
integer, allocatable :: a
integer, pointer :: p2(:) => null()
end type t2
type(t2), save :: x
integer, save :: s, v(2)
call sub1 (v, x%p2)
contains
elemental subroutine sub1 (x, y)
integer, intent(inout) :: x
integer, intent(in), optional :: y
end subroutine sub1
end
gcc/predict.c | 79 +++++++++++++++++++++++++++++++++++++++++++--------------
gcc/predict.def | 5 ++++
2 files changed, 65 insertions(+), 19 deletions(-)
diff --git a/gcc/predict.c b/gcc/predict.c
index db5eed9..94f4df9 100644
--- a/gcc/predict.c
+++ b/gcc/predict.c
@@ -956,7 +956,8 @@ combine_predictions_for_bb (basic_block bb)
struct edge_prediction *pred2;
int prob = probability;
- for (pred2 = (struct edge_prediction *) *preds; pred2; pred2 = pred2->ep_next)
+ for (pred2 = (struct edge_prediction *) *preds;
+ pred2; pred2 = pred2->ep_next)
if (pred2 != pred && pred2->ep_predictor == pred->ep_predictor)
{
int probability2 = pred->ep_probability;
@@ -1788,16 +1789,19 @@ guess_outgoing_edge_probabilities (basic_block bb)
combine_predictions_for_insn (BB_END (bb), bb);
}
-static tree expr_expected_value (tree, bitmap);
+static tree expr_expected_value (tree, bitmap, enum br_predictor *predictor);
/* Helper function for expr_expected_value. */
static tree
expr_expected_value_1 (tree type, tree op0, enum tree_code code,
- tree op1, bitmap visited)
+ tree op1, bitmap visited, enum br_predictor *predictor)
{
gimple def;
+ if (*predictor)
+ *predictor = PRED_UNCONDITIONAL;
+
if (get_gimple_rhs_class (code) == GIMPLE_SINGLE_RHS)
{
if (TREE_CONSTANT (op0))
@@ -1822,6 +1826,7 @@ expr_expected_value_1 (tree type, tree op0, enum tree_code code,
for (i = 0; i < n; i++)
{
tree arg = PHI_ARG_DEF (def, i);
+ enum br_predictor predictor2;
/* If this PHI has itself as an argument, we cannot
determine the string length of this argument. However,
@@ -1832,7 +1837,12 @@ expr_expected_value_1 (tree type, tree op0, enum tree_code code,
if (arg == PHI_RESULT (def))
continue;
- new_val = expr_expected_value (arg, visited);
+ new_val = expr_expected_value (arg, visited, &predictor2);
+
+ /* It is diffcult to combine value predictors. Simply assume that
+ later predictor is weaker and take its prediction. */
+ if (predictor && *predictor < predictor2)
+ *predictor = predictor2;
if (!new_val)
return NULL;
if (!val)
@@ -1851,7 +1861,7 @@ expr_expected_value_1 (tree type, tree op0, enum tree_code code,
gimple_assign_rhs1 (def),
gimple_assign_rhs_code (def),
gimple_assign_rhs2 (def),
- visited);
+ visited, predictor);
}
if (is_gimple_call (def))
@@ -1865,11 +1875,26 @@ expr_expected_value_1 (tree type, tree op0, enum tree_code code,
case BUILT_IN_EXPECT:
{
tree val;
- if (gimple_call_num_args (def) != 2)
+ if (gimple_call_num_args (def) > 3
+ || gimple_call_num_args (def) < 2)
return NULL;
val = gimple_call_arg (def, 0);
if (TREE_CONSTANT (val))
return val;
+ if (*predictor)
+ {
+ *predictor = PRED_BUILTIN_EXPECT;
+ /* Optionally, frontend generate BUILTIN_EXPECT can add
+ third argument specifying the predictor used. */
+ if (gimple_call_num_args (def) == 3)
+ {
+ tree val2 = gimple_call_arg (def, 2);
+ if (TREE_CODE (val2) == INTEGER_CST
+ && tree_fits_uhwi_p (val2)
+ && tree_to_uhwi (val2) < END_PREDICTORS)
+ *predictor = (enum br_predictor)tree_to_uhwi (val2);
+ }
+ }
return gimple_call_arg (def, 1);
}
@@ -1888,6 +1913,8 @@ expr_expected_value_1 (tree type, tree op0, enum tree_code code,
case BUILT_IN_ATOMIC_COMPARE_EXCHANGE_16:
/* Assume that any given atomic operation has low contention,
and thus the compare-and-swap operation succeeds. */
+ if (predictor)
+ *predictor = PRED_COMPARE_AND_SWAP;
return boolean_true_node;
}
}
@@ -1898,10 +1925,13 @@ expr_expected_value_1 (tree type, tree op0, enum tree_code code,
if (get_gimple_rhs_class (code) == GIMPLE_BINARY_RHS)
{
tree res;
- op0 = expr_expected_value (op0, visited);
+ enum br_predictor predictor2;
+ op0 = expr_expected_value (op0, visited, predictor);
if (!op0)
return NULL;
- op1 = expr_expected_value (op1, visited);
+ op1 = expr_expected_value (op1, visited, &predictor2);
+ if (predictor && *predictor < predictor2)
+ *predictor = predictor2;
if (!op1)
return NULL;
res = fold_build2 (code, type, op0, op1);
@@ -1912,7 +1942,7 @@ expr_expected_value_1 (tree type, tree op0, enum tree_code code,
if (get_gimple_rhs_class (code) == GIMPLE_UNARY_RHS)
{
tree res;
- op0 = expr_expected_value (op0, visited);
+ op0 = expr_expected_value (op0, visited, predictor);
if (!op0)
return NULL;
res = fold_build1 (code, type, op0);
@@ -1932,17 +1962,22 @@ expr_expected_value_1 (tree type, tree op0, enum tree_code code,
implementation. */
static tree
-expr_expected_value (tree expr, bitmap visited)
+expr_expected_value (tree expr, bitmap visited,
+ enum br_predictor *predictor)
{
enum tree_code code;
tree op0, op1;
if (TREE_CONSTANT (expr))
- return expr;
+ {
+ if (*predictor)
+ *predictor = PRED_UNCONDITIONAL;
+ return expr;
+ }
extract_ops_from_tree (expr, &code, &op0, &op1);
return expr_expected_value_1 (TREE_TYPE (expr),
- op0, code, op1, visited);
+ op0, code, op1, visited, predictor);
}
@@ -2008,6 +2043,7 @@ tree_predict_by_opcode (basic_block bb)
enum tree_code cmp;
bitmap visited;
edge_iterator ei;
+ enum br_predictor predictor;
if (!stmt || gimple_code (stmt) != GIMPLE_COND)
return;
@@ -2019,16 +2055,21 @@ tree_predict_by_opcode (basic_block bb)
cmp = gimple_cond_code (stmt);
type = TREE_TYPE (op0);
visited = BITMAP_ALLOC (NULL);
- val = expr_expected_value_1 (boolean_type_node, op0, cmp, op1, visited);
+ val = expr_expected_value_1 (boolean_type_node, op0, cmp, op1, visited, &predictor);
BITMAP_FREE (visited);
- if (val)
+ if (val && TREE_CONSTANT (val))
{
- int percent = PARAM_VALUE (BUILTIN_EXPECT_PROBABILITY);
+ if (predictor == PRED_BUILTIN_EXPECT)
+ {
+ int percent = PARAM_VALUE (BUILTIN_EXPECT_PROBABILITY);
- gcc_assert (percent >= 0 && percent <= 100);
- if (integer_zerop (val))
- percent = 100 - percent;
- predict_edge (then_edge, PRED_BUILTIN_EXPECT, HITRATE (percent));
+ gcc_assert (percent >= 0 && percent <= 100);
+ if (integer_zerop (val))
+ percent = 100 - percent;
+ predict_edge (then_edge, PRED_BUILTIN_EXPECT, HITRATE (percent));
+ }
+ else
+ predict_edge (then_edge, predictor, integer_zerop (val) ? NOT_TAKEN : TAKEN);
}
/* Try "pointer heuristic."
A comparison ptr == 0 is predicted as false.
diff --git a/gcc/predict.def b/gcc/predict.def
index f4eddc5..7138b9c 100644
--- a/gcc/predict.def
+++ b/gcc/predict.def
@@ -57,6 +57,11 @@ DEF_PREDICTOR (PRED_UNCONDITIONAL, "unconditional jump", PROB_ALWAYS,
DEF_PREDICTOR (PRED_LOOP_ITERATIONS, "loop iterations", PROB_ALWAYS,
PRED_FLAG_FIRST_MATCH)
+/* Assume that any given atomic operation has low contention,
+ and thus the compare-and-swap operation succeeds. */
+DEF_PREDICTOR (PRED_COMPARE_AND_SWAP, "compare and swap", PROB_VERY_LIKELY,
+ PRED_FLAG_FIRST_MATCH)
+
/* Hints dropped by user via __builtin_expect feature. Note: the
probability of PROB_VERY_LIKELY is now overwritten by param
builtin_expect_probability with a default value of HITRATE(90).
gcc/
2014-03-01 Tobias Burnus <bur...@net-b.de>
PR ipa/58721
* predict.def (PRED_FORTRAN_OVERFLOW, PRED_FORTRAN_FAIL_ALLOC,
PRED_FORTRAN_FAIL_IO, PRED_FORTRAN_WARN_ONCE, PRED_FORTRAN_SIZE_ZERO,
PRED_FORTRAN_INVALID_BOUND, PRED_FORTRAN_ABSENT_DUMMY): Add.
gcc/fortran/
2014-03-01 Tobias Burnus <bur...@net-b.de>
PR ipa/58721
* trans.h (gfc_unlikely, gfc_likely): Add predictor as argument.
(gfc_trans_io_runtime_check): Remove.
* trans-io.c (gfc_trans_io_runtime_check): Make static; add has_iostat
as argument, add predictor to block.
(set_parameter_value, gfc_trans_open, gfc_trans_close, build_filepos,
gfc_trans_inquire, gfc_trans_wait, build_dt): Update calls.
* trans.c (gfc_unlikely, gfc_likely): Add predictor as argument.
(gfc_trans_runtime_check, gfc_allocate_using_malloc,
gfc_allocate_allocatable, gfc_deallocate_with_status): Set explicitly
branch predictor.
* trans-expr.c (gfc_conv_procedure_call): Ditto.
* trans-stmt.c (gfc_trans_allocate): Ditto.
* trans-array.c (gfc_array_init_size, gfc_array_allocate): Ditto.
gcc/fortran/trans-array.c | 18 +++++++++-----
gcc/fortran/trans-expr.c | 2 +-
gcc/fortran/trans-intrinsic.c | 3 +--
gcc/fortran/trans-io.c | 55 +++++++++++++++++++++++++-----------------
gcc/fortran/trans-stmt.c | 8 +++----
gcc/fortran/trans.c | 56 ++++++++++++++++++++++++++++---------------
gcc/fortran/trans.h | 7 +++---
gcc/predict.def | 38 +++++++++++++++++++++++++++++
8 files changed, 130 insertions(+), 57 deletions(-)
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 8e7b75e..381eaf8 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -4993,12 +4993,14 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
TYPE_MAX_VALUE (gfc_array_index_type)),
size);
cond = gfc_unlikely (fold_build2_loc (input_location, LT_EXPR,
- boolean_type_node, tmp, stride));
+ boolean_type_node, tmp, stride),
+ PRED_FORTRAN_OVERFLOW);
tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond,
integer_one_node, integer_zero_node);
cond = gfc_unlikely (fold_build2_loc (input_location, EQ_EXPR,
boolean_type_node, size,
- gfc_index_zero_node));
+ gfc_index_zero_node),
+ PRED_FORTRAN_SIZE_ZERO);
tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond,
integer_zero_node, tmp);
tmp = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node,
@@ -5095,12 +5097,14 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
size_type_node,
TYPE_MAX_VALUE (size_type_node), element_size);
cond = gfc_unlikely (fold_build2_loc (input_location, LT_EXPR,
- boolean_type_node, tmp, stride));
+ boolean_type_node, tmp, stride),
+ PRED_FORTRAN_OVERFLOW);
tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond,
integer_one_node, integer_zero_node);
cond = gfc_unlikely (fold_build2_loc (input_location, EQ_EXPR,
boolean_type_node, element_size,
- build_int_cst (size_type_node, 0)));
+ build_int_cst (size_type_node, 0)),
+ PRED_FORTRAN_SIZE_ZERO);
tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond,
integer_zero_node, tmp);
tmp = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node,
@@ -5282,7 +5286,8 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
if (dimension)
{
cond = gfc_unlikely (fold_build2_loc (input_location, NE_EXPR,
- boolean_type_node, var_overflow, integer_zero_node));
+ boolean_type_node, var_overflow, integer_zero_node),
+ PRED_FORTRAN_OVERFLOW);
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
error, gfc_finish_block (&elseblock));
}
@@ -5303,7 +5308,8 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
build_int_cst (TREE_TYPE (status), 0));
gfc_add_expr_to_block (&se->pre,
fold_build3_loc (input_location, COND_EXPR, void_type_node,
- gfc_likely (cond), set_descriptor,
+ gfc_likely (cond, PRED_FORTRAN_FAIL_ALLOC),
+ set_descriptor,
build_empty_stmt (input_location)));
}
else
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 297ff67..ec154b8 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -4091,7 +4091,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
parmse.expr
= fold_build3_loc (input_location, COND_EXPR,
TREE_TYPE (parmse.expr),
- gfc_unlikely (tmp),
+ gfc_unlikely (tmp, PRED_FORTRAN_ABSENT_DUMMY),
fold_convert (TREE_TYPE (parmse.expr),
null_pointer_node),
parmse.expr);
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index cff8e89..3051cb4 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1196,8 +1196,7 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
boolean_type_node, invalid_bound, cond);
}
- invalid_bound = gfc_unlikely (invalid_bound);
-
+ invalid_bound = gfc_unlikely (invalid_bound, PRED_FORTRAN_INVALID_BOUND);
/* See Fortran 2008, C.10 for the following algorithm. */
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 853e77d..d151598 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -230,9 +230,10 @@ gfc_build_st_parameter (enum ioparam_type ptype, tree *types)
Therefore, the code to set these flags must be generated before
this function is used. */
-void
-gfc_trans_io_runtime_check (tree cond, tree var, int error_code,
- const char * msgid, stmtblock_t * pblock)
+static void
+gfc_trans_io_runtime_check (bool has_iostat, tree cond, tree var,
+ int error_code, const char * msgid,
+ stmtblock_t * pblock)
{
stmtblock_t block;
tree body;
@@ -246,6 +247,13 @@ gfc_trans_io_runtime_check (tree cond, tree var, int error_code,
/* The code to generate the error. */
gfc_start_block (&block);
+ if (has_iostat)
+ gfc_add_expr_to_block (&block, build_predict_expr (PRED_FORTRAN_FAIL_IO,
+ NOT_TAKEN));
+ else
+ gfc_add_expr_to_block (&block, build_predict_expr (PRED_NORETURN,
+ NOT_TAKEN));
+
arg1 = gfc_build_addr_expr (NULL_TREE, var);
arg2 = build_int_cst (integer_type_node, error_code),
@@ -268,7 +276,6 @@ gfc_trans_io_runtime_check (tree cond, tree var, int error_code,
}
else
{
- cond = gfc_unlikely (cond);
tmp = build3_v (COND_EXPR, cond, body, build_empty_stmt (input_location));
gfc_add_expr_to_block (pblock, tmp);
}
@@ -494,8 +501,8 @@ set_parameter_const (stmtblock_t *block, tree var, enum iofield type,
st_parameter_XXX structure. This is a pass by value. */
static unsigned int
-set_parameter_value (stmtblock_t *block, tree var, enum iofield type,
- gfc_expr *e)
+set_parameter_value (stmtblock_t *block, bool has_iostat, tree var,
+ enum iofield type, gfc_expr *e)
{
gfc_se se;
tree tmp;
@@ -520,18 +527,18 @@ set_parameter_value (stmtblock_t *block, tree var, enum iofield type,
cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
se.expr,
fold_convert (TREE_TYPE (se.expr), val));
- gfc_trans_io_runtime_check (cond, var, LIBERROR_BAD_UNIT,
- "Unit number in I/O statement too small",
- &se.pre);
+ gfc_trans_io_runtime_check (has_iostat, cond, var, LIBERROR_BAD_UNIT,
+ "Unit number in I/O statement too small",
+ &se.pre);
/* UNIT numbers should be less than the max. */
val = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].huge, 4);
cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
se.expr,
fold_convert (TREE_TYPE (se.expr), val));
- gfc_trans_io_runtime_check (cond, var, LIBERROR_BAD_UNIT,
- "Unit number in I/O statement too large",
- &se.pre);
+ gfc_trans_io_runtime_check (has_iostat, cond, var, LIBERROR_BAD_UNIT,
+ "Unit number in I/O statement too large",
+ &se.pre);
}
@@ -960,7 +967,8 @@ gfc_trans_open (gfc_code * code)
mask |= set_string (&block, &post_block, var, IOPARM_open_form, p->form);
if (p->recl)
- mask |= set_parameter_value (&block, var, IOPARM_open_recl_in, p->recl);
+ mask |= set_parameter_value (&block, p->iostat, var, IOPARM_open_recl_in,
+ p->recl);
if (p->blank)
mask |= set_string (&block, &post_block, var, IOPARM_open_blank,
@@ -1010,7 +1018,7 @@ gfc_trans_open (gfc_code * code)
set_parameter_const (&block, var, IOPARM_common_flags, mask);
if (p->unit)
- set_parameter_value (&block, var, IOPARM_common_unit, p->unit);
+ set_parameter_value (&block, p->iostat, var, IOPARM_common_unit, p->unit);
else
set_parameter_const (&block, var, IOPARM_common_unit, 0);
@@ -1063,7 +1071,7 @@ gfc_trans_close (gfc_code * code)
set_parameter_const (&block, var, IOPARM_common_flags, mask);
if (p->unit)
- set_parameter_value (&block, var, IOPARM_common_unit, p->unit);
+ set_parameter_value (&block, p->iostat, var, IOPARM_common_unit, p->unit);
else
set_parameter_const (&block, var, IOPARM_common_unit, 0);
@@ -1114,7 +1122,7 @@ build_filepos (tree function, gfc_code * code)
set_parameter_const (&block, var, IOPARM_common_flags, mask);
if (p->unit)
- set_parameter_value (&block, var, IOPARM_common_unit, p->unit);
+ set_parameter_value (&block, p->iostat, var, IOPARM_common_unit, p->unit);
else
set_parameter_const (&block, var, IOPARM_common_unit, 0);
@@ -1375,7 +1383,7 @@ gfc_trans_inquire (gfc_code * code)
set_parameter_const (&block, var, IOPARM_common_flags, mask);
if (p->unit)
- set_parameter_value (&block, var, IOPARM_common_unit, p->unit);
+ set_parameter_value (&block, p->iostat, var, IOPARM_common_unit, p->unit);
else
set_parameter_const (&block, var, IOPARM_common_unit, 0);
@@ -1422,12 +1430,12 @@ gfc_trans_wait (gfc_code * code)
mask |= IOPARM_common_err;
if (p->id)
- mask |= set_parameter_value (&block, var, IOPARM_wait_id, p->id);
+ mask |= set_parameter_value (&block, p->iostat, var, IOPARM_wait_id, p->id);
set_parameter_const (&block, var, IOPARM_common_flags, mask);
if (p->unit)
- set_parameter_value (&block, var, IOPARM_common_unit, p->unit);
+ set_parameter_value (&block, p->iostat, var, IOPARM_common_unit, p->unit);
tmp = gfc_build_addr_expr (NULL_TREE, var);
tmp = build_call_expr_loc (input_location,
@@ -1718,7 +1726,8 @@ build_dt (tree function, gfc_code * code)
IOPARM_dt_id, dt->id);
if (dt->pos)
- mask |= set_parameter_value (&block, var, IOPARM_dt_pos, dt->pos);
+ mask |= set_parameter_value (&block, dt->iostat, var, IOPARM_dt_pos,
+ dt->pos);
if (dt->asynchronous)
mask |= set_string (&block, &post_block, var, IOPARM_dt_asynchronous,
@@ -1749,7 +1758,8 @@ build_dt (tree function, gfc_code * code)
dt->sign);
if (dt->rec)
- mask |= set_parameter_value (&block, var, IOPARM_dt_rec, dt->rec);
+ mask |= set_parameter_value (&block, dt->iostat, var, IOPARM_dt_rec,
+ dt->rec);
if (dt->advance)
mask |= set_string (&block, &post_block, var, IOPARM_dt_advance,
@@ -1801,7 +1811,8 @@ build_dt (tree function, gfc_code * code)
set_parameter_const (&block, var, IOPARM_common_flags, mask);
if (dt->io_unit && dt->io_unit->ts.type == BT_INTEGER)
- set_parameter_value (&block, var, IOPARM_common_unit, dt->io_unit);
+ set_parameter_value (&block, dt->iostat, var, IOPARM_common_unit,
+ dt->io_unit);
}
else
set_parameter_const (&block, var, IOPARM_common_flags, mask);
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 19e29a7..d202e4e 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5102,8 +5102,8 @@ gfc_trans_allocate (gfc_code * code)
boolean_type_node, stat,
build_int_cst (TREE_TYPE (stat), 0));
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
- gfc_unlikely (parm), tmp,
- build_empty_stmt (input_location));
+ gfc_unlikely (parm, PRED_FORTRAN_FAIL_ALLOC),
+ tmp, build_empty_stmt (input_location));
gfc_add_expr_to_block (&block, tmp);
}
@@ -5496,7 +5496,7 @@ gfc_trans_deallocate (gfc_code *code)
cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, stat,
build_int_cst (TREE_TYPE (stat), 0));
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
- gfc_unlikely (cond),
+ gfc_unlikely (cond, PRED_FORTRAN_FAIL_ALLOC),
build1_v (GOTO_EXPR, label_errmsg),
build_empty_stmt (input_location));
gfc_add_expr_to_block (&se.pre, tmp);
@@ -5536,7 +5536,7 @@ gfc_trans_deallocate (gfc_code *code)
cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, stat,
build_int_cst (TREE_TYPE (stat), 0));
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
- gfc_unlikely (cond), tmp,
+ gfc_unlikely (cond, PRED_FORTRAN_FAIL_ALLOC), tmp,
build_empty_stmt (input_location));
gfc_add_expr_to_block (&block, tmp);
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index c5b3b9e..ca0afa9 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,7 +2031,7 @@ 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;
@@ -2023,7 +2039,8 @@ gfc_unlikely (tree 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);
+ 3, cond, tmp,
+ build_int_cst (integer_type_node, predictor));
cond = fold_convert (boolean_type_node, cond);
return cond;
}
@@ -2032,7 +2049,7 @@ 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;
@@ -2040,7 +2057,8 @@ gfc_likely (tree 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);
+ 3, cond, tmp,
+ build_int_cst (integer_type_node, predictor));
cond = fold_convert (boolean_type_node, cond);
return cond;
}
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index e05a375..7dab4f6 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -21,6 +21,8 @@ along with GCC; see the file COPYING3. If not see
#ifndef GFC_TRANS_H
#define GFC_TRANS_H
+#include "predict.h" /* For enum br_predictor and PRED_*. */
+
/* Mangled symbols take the form __module__name. */
#define GFC_MAX_MANGLED_SYMBOL_LEN (GFC_MAX_SYMBOL_LEN*2+4)
@@ -578,8 +580,8 @@ void gfc_generate_constructors (void);
bool get_array_ctor_strlen (stmtblock_t *, gfc_constructor_base, tree *);
/* Mark a condition as likely or unlikely. */
-tree gfc_likely (tree);
-tree gfc_unlikely (tree);
+tree gfc_likely (tree, enum br_predictor);
+tree gfc_unlikely (tree, enum br_predictor);
/* Generate a runtime error call. */
tree gfc_trans_runtime_error (bool, locus*, const char*, ...);
@@ -625,7 +627,6 @@ tree gfc_trans_pointer_assignment (gfc_expr *, gfc_expr *);
/* Initialize function decls for library functions. */
void gfc_build_intrinsic_lib_fndecls (void);
/* Create function decls for IO library functions. */
-void gfc_trans_io_runtime_check (tree, tree, int, const char *, stmtblock_t *);
void gfc_build_io_library_fndecls (void);
/* Build a function decl for a library function. */
tree gfc_build_library_function_decl (tree, tree, int, ...);
diff --git a/gcc/predict.def b/gcc/predict.def
index 7138b9c..145330c 100644
--- a/gcc/predict.def
+++ b/gcc/predict.def
@@ -138,3 +138,41 @@ DEF_PREDICTOR (PRED_HOT_LABEL, "hot label", HITRATE (85), 0)
/* Branches to cold labels are extremely unlikely. */
DEF_PREDICTOR (PRED_COLD_LABEL, "cold label", PROB_VERY_LIKELY,
PRED_FLAG_FIRST_MATCH)
+
+
+/* The following predictors are used in Fortran. */
+
+/* Branch leading to an integer overflow are extremely unlikely. */
+DEF_PREDICTOR (PRED_FORTRAN_OVERFLOW, "overflow", PROB_ALWAYS,
+ PRED_FLAG_FIRST_MATCH)
+
+/* Branch leading to a failure status are unlikely. This can occur for out
+ of memory or when trying to allocate an already allocated allocated or
+ deallocating an already deallocated allocatable. This predictor only
+ occurs when the user explicitly asked for a return status. By default,
+ the code aborts, which is handled via PRED_NORETURN. */
+DEF_PREDICTOR (PRED_FORTRAN_FAIL_ALLOC, "fail alloc", PROB_VERY_LIKELY, 0)
+
+/* Branch leading to an I/O failure status are unlikely. This predictor is
+ used for I/O failures such as for invalid unit numbers. This predictor
+ only occurs when the user explicitly asked for a return status. By default,
+ the code aborts, which is handled via PRED_NORETURN. */
+DEF_PREDICTOR (PRED_FORTRAN_FAIL_IO, "fail alloc", HITRATE(85), 0)
+
+/* Branch leading to a run-time warning message which is printed only once
+ are unlikely. The print-warning branch itself can be likely or unlikely. */
+DEF_PREDICTOR (PRED_FORTRAN_WARN_ONCE, "warn once", HITRATE (75), 0)
+
+/* Branch belonging to a zero-sized array. */
+DEF_PREDICTOR (PRED_FORTRAN_SIZE_ZERO, "zero-sized array", HITRATE(70), 0)
+
+/* Branch belonging to an invalid bound index, in a context where it is
+ standard conform and well defined but rather pointless and, hence, rather
+ unlikely to occur. */
+DEF_PREDICTOR (PRED_FORTRAN_INVALID_BOUND, "zero-sized array", HITRATE(90), 0)
+
+/* Branch belonging to the handling of absent optional arguments. This
+ predictor is used when an optional dummy argument, associated with an
+ absent argument, is passed on as actual argument to another procedure,
+ which in turn has an optional argument. */
+DEF_PREDICTOR (PRED_FORTRAN_ABSENT_DUMMY, "absent dummy", HITRATE(60), 0)
