 predict.def               |   16 +++++++

 fortran/trans-array.c     |   26 +++++++-----
 fortran/trans-expr.c      |   15 ++++---
 fortran/trans-intrinsic.c |    3 -
 fortran/trans-io.c        |    1 
 fortran/trans-stmt.c      |   26 ++++++++----
 fortran/trans.c           |   97 +++++++++++++++++++++++-----------------------
 fortran/trans.h           |    4 -

 8 files changed, 107 insertions(+), 81 deletions(-)

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 78b08d7..8f4db5a 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -79,6 +79,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "system.h"
 #include "coretypes.h"
 #include "tree.h"
+#include "predict.h"	/* For PRED_FAIL.  */
 #include "gimple-expr.h"
 #include "diagnostic-core.h"	/* For internal_error/fatal_error.  */
 #include "flags.h"
@@ -4987,13 +4988,12 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
 			     fold_convert (gfc_array_index_type,
 					   TYPE_MAX_VALUE (gfc_array_index_type)),
 					   size);
-      cond = gfc_unlikely (fold_build2_loc (input_location, LT_EXPR,
-					    boolean_type_node, tmp, stride));
+      cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, tmp, stride);
       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,
+      cond = /*gfc_unlikely (*/fold_build2_loc (input_location, EQ_EXPR,
 					    boolean_type_node, size,
-					    gfc_index_zero_node));
+					    gfc_index_zero_node);
       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,
@@ -5089,13 +5089,13 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
   tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
 			 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));
+  cond = /*gfc_unlikely (*/fold_build2_loc (input_location, LT_EXPR,
+					boolean_type_node, tmp, stride);
   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,
+  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));
   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,
@@ -5222,6 +5222,8 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
   overflow = integer_zero_node;
 
   gfc_init_block (&set_descriptor_block);
+  gfc_add_expr_to_block (&set_descriptor_block,
+			 build_predict_expr (PRED_FAIL, TAKEN));
   size = gfc_array_init_size (se->expr, ref->u.ar.as->rank,
 			      ref->u.ar.as->corank, &offset, lower, upper,
 			      &se->pre, &set_descriptor_block, &overflow,
@@ -5248,6 +5250,8 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
 	  stmtblock_t set_status_block;
 
 	  gfc_start_block (&set_status_block);
+	  gfc_add_expr_to_block (&set_status_block,
+				 build_predict_expr (PRED_FAIL, NOT_TAKEN));
 	  gfc_add_modify (&set_status_block, status,
 			  build_int_cst (status_type, LIBERROR_ALLOCATION));
 	  error = gfc_finish_block (&set_status_block);
@@ -5276,8 +5280,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));
+      cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			      var_overflow, integer_zero_node);
       tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
 			     error, gfc_finish_block (&elseblock));
     }
@@ -5298,7 +5302,7 @@ 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,
+				  cond, set_descriptor,
 				  build_empty_stmt (input_location)));
     }
   else
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 62ba932..9dda723 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -25,6 +25,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "system.h"
 #include "coretypes.h"
 #include "tree.h"
+#include "predict.h"	/* For PRED_FAIL.  */
 #include "stringpool.h"
 #include "diagnostic-core.h"	/* For fatal_error.  */
 #include "langhooks.h"
@@ -4080,7 +4081,14 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	  if (ss->info->can_be_null_ref && ss->info->type != GFC_SS_REFERENCE)
 	    {
 	      tree descriptor_data;
+	      stmtblock_t err_block;
 
+	      gfc_init_block (&err_block);
+	      gfc_add_expr_to_block (&err_block,
+				     build_predict_expr (PRED_ZERO, NOT_TAKEN));
+	      gfc_add_expr_to_block (&err_block,
+				     fold_convert (TREE_TYPE (parmse.expr),
+						   null_pointer_node));
 	      descriptor_data = ss->info->data.array.data;
 	      tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
 				     descriptor_data,
@@ -4088,11 +4096,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 						   null_pointer_node));
 	      parmse.expr
 		= fold_build3_loc (input_location, COND_EXPR,
-				   TREE_TYPE (parmse.expr),
-				   gfc_unlikely (tmp),
-				   fold_convert (TREE_TYPE (parmse.expr),
-						 null_pointer_node),
-				   parmse.expr);
+				   TREE_TYPE (parmse.expr), tmp,
+				   gfc_finish_block (&err_block), parmse.expr);
 	    }
 
 	  /* The scalarizer does not repackage the reference to a class
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 4acdc8d..f7df6b7 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1196,9 +1196,6 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
 				       boolean_type_node, invalid_bound, cond);
     }
 
-  invalid_bound = gfc_unlikely (invalid_bound);
-
-
   /* See Fortran 2008, C.10 for the following algorithm.  */
 
   /* coindex = sub(corank) - lcobound(n).  */
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 9b46a4e..fd5f50b 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -268,7 +268,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);
     }
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 4f21197..76d1124 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -24,6 +24,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "system.h"
 #include "coretypes.h"
 #include "tree.h"
+#include "predict.h"	/* For PRED_FAIL.  */
 #include "stringpool.h"
 #include "gfortran.h"
 #include "flags.h"
@@ -5086,13 +5087,18 @@ gfc_trans_allocate (gfc_code * code)
       /* Error checking -- Note: ERRMSG only makes sense with STAT.  */
       if (code->expr1)
 	{
-	  tmp = build1_v (GOTO_EXPR, label_errmsg);
+	  stmtblock_t err_block;
+	  gfc_init_block (&err_block);
+	  gfc_add_expr_to_block (&err_block, build_predict_expr (PRED_FAIL,
+								 NOT_TAKEN));
+	  gfc_add_expr_to_block (&err_block,
+				 build1_v (GOTO_EXPR, label_errmsg));
 	  parm = 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 (parm), tmp,
-				     build_empty_stmt (input_location));
+				 parm, gfc_finish_block (&err_block),
+				 build_empty_stmt (input_location));
 	  gfc_add_expr_to_block (&block, tmp);
 	}
 
@@ -5448,13 +5454,16 @@ gfc_trans_deallocate (gfc_code *code)
 
       if (code->expr1)
 	{
-          tree cond;
-
+	  tree cond;
+	  stmtblock_t err_block;
+	  gfc_init_block (&err_block);
+	  gfc_add_expr_to_block (&err_block, build_predict_expr (PRED_FAIL,
+								 NOT_TAKEN));
+	  gfc_add_expr_to_block (&err_block, build1_v (GOTO_EXPR, label_errmsg));
 	  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),
-				 build1_v (GOTO_EXPR, label_errmsg),
+				 cond, gfc_finish_block (&err_block),
 				 build_empty_stmt (input_location));
 	  gfc_add_expr_to_block (&se.pre, tmp);
 	}
@@ -5493,8 +5502,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,
-			     build_empty_stmt (input_location));
+			     cond, 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 9e57058..580c981 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -25,6 +25,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "gimple-expr.h"	/* For create_tmp_var_raw.  */
 #include "stringpool.h"
 #include "tree-iterator.h"
+#include "predict.h"	/* For PRED_WARN_CALL.  */
 #include "diagnostic-core.h"  /* For internal_error.  */
 #include "flags.h"
 #include "gfortran.h"
@@ -491,6 +492,12 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock,
   if (integer_zerop (cond))
     return;
 
+  /* Mark branch belonging to the warning condition as less likely.  Error is
+     handled via noreturn.  */
+  if (!error)
+    gfc_add_expr_to_block (pblock, build_predict_expr (PRED_WARN_CALL,
+						       NOT_TAKEN));
+
   if (once)
     {
        tmpvar = gfc_create_var (boolean_type_node, "print_warning");
@@ -526,7 +533,6 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock,
       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));
@@ -641,9 +647,18 @@ gfc_allocate_using_malloc (stmtblock_t * block, tree pointer,
 
   /* What to do in case of error.  */
   if (status != NULL_TREE)
-    on_error = fold_build2_loc (input_location, MODIFY_EXPR, status_type,
-			status, build_int_cst (status_type, LIBERROR_ALLOCATION));
+    {
+      stmtblock_t err_block;
+      gfc_init_block (&err_block);
+      gfc_add_expr_to_block (&err_block, build_predict_expr (PRED_OVERFLOW,
+							     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 (&err_block, tmp);
+      on_error = gfc_finish_block (&err_block);
+    }
   else
+    /* No need for a predict as noreturn is set.  */
     on_error = build_call_expr_loc (input_location, gfor_fndecl_os_error, 1,
 		    gfc_build_addr_expr (pchar_type_node,
 				 gfc_build_localized_cstring_const
@@ -653,7 +668,7 @@ gfc_allocate_using_malloc (stmtblock_t * block, tree pointer,
 				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, on_error,
 			 build_empty_stmt (input_location));
 
   gfc_add_expr_to_block (block, tmp);
@@ -748,9 +763,8 @@ gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree token,
   if (TREE_TYPE (size) != TREE_TYPE (size_type_node))
     size = fold_convert (size_type_node, size);
 
-  null_mem = gfc_unlikely (fold_build2_loc (input_location, NE_EXPR,
-					    boolean_type_node, mem,
-					    build_int_cst (type, 0)));
+  null_mem = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, mem,
+			      build_int_cst (type, 0));
 
   /* If mem is NULL, we call gfc_allocate_using_malloc or
      gfc_allocate_using_lib.  */
@@ -765,12 +779,17 @@ gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree token,
 			      errmsg, errlen);
       if (status != NULL_TREE)
 	{
+          stmtblock_t err_block;
+
+          gfc_init_block (&err_block);
 	  TREE_USED (label_finish) = 1;
-	  tmp = build1_v (GOTO_EXPR, label_finish);
+	  gfc_add_expr_to_block (&err_block, build_predict_expr (PRED_FAIL,
+								 NOT_TAKEN));
+	  gfc_add_expr_to_block (&err_block,  build1_v (GOTO_EXPR, label_finish));
 	  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,
+				 cond, gfc_finish_block (&err_block),
 				 build_empty_stmt (input_location));
 	  gfc_add_expr_to_block (&alloc_block, tmp);
 	}
@@ -802,10 +821,16 @@ gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree token,
 
   if (status != NULL_TREE)
     {
+      stmtblock_t err_block;
       tree status_type = TREE_TYPE (status);
 
+      gfc_init_block (&err_block);
+      gfc_add_expr_to_block (&err_block, build_predict_expr (PRED_FAIL,
+							     NOT_TAKEN));
       error = fold_build2_loc (input_location, MODIFY_EXPR, status_type,
 	      status, build_int_cst (status_type, LIBERROR_ALLOCATION));
+      gfc_add_expr_to_block (&err_block, error);
+      error = gfc_finish_block (&err_block);
     }
 
   tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, null_mem,
@@ -1257,18 +1282,23 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg,
       if (status != NULL_TREE && !integer_zerop (status))
 	{
 	  /* We set STATUS to zero if it is present.  */
+	  stmtblock_t err_block;
 	  tree status_type = TREE_TYPE (TREE_TYPE (status));
 	  tree cond2;
 
 	  cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
 				   status,
 				   build_int_cst (TREE_TYPE (status), 0));
-	  tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type,
+	  gfc_init_block (&err_block);
+	  gfc_add_expr_to_block (&err_block, build_predict_expr (PRED_FAIL,
+								 NOT_TAKEN));
+	  gfc_add_expr_to_block (&err_block,
+		fold_build2_loc (input_location, MODIFY_EXPR, status_type,
 				 fold_build1_loc (input_location, INDIRECT_REF,
 						  status_type, status),
-				 build_int_cst (status_type, 0));
+				 build_int_cst (status_type, 0)));
 	  tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
-				 gfc_unlikely (cond2), tmp,
+				 cond2, gfc_finish_block (&err_block),
 				 build_empty_stmt (input_location));
 	  gfc_add_expr_to_block (&non_null, tmp);
 	}
@@ -1320,14 +1350,19 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg,
 
       if (status != NULL_TREE)
 	{
+	  stmtblock_t err_block;
 	  tree stat = build_fold_indirect_ref_loc (input_location, status);
 
+	  gfc_init_block (&err_block);
+	  gfc_add_expr_to_block (&err_block, build_predict_expr (PRED_FAIL,
+								 NOT_TAKEN));
 	  TREE_USED (label_finish) = 1;
-	  tmp = build1_v (GOTO_EXPR, label_finish);
+	  gfc_add_expr_to_block (&err_block,
+				 build1_v (GOTO_EXPR, label_finish));
 	  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,
+				 cond2, gfc_finish_block (&err_block),
 				 build_empty_stmt (input_location));
 	  gfc_add_expr_to_block (&non_null, tmp);
 	}
@@ -2010,37 +2045,3 @@ gfc_finish_wrapped_block (gfc_wrapped_block* block)
 
   return result;
 }
-
-
-/* Helper function for marking a boolean expression tree as unlikely.  */
-
-tree
-gfc_unlikely (tree cond)
-{
-  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);
-  cond = fold_convert (boolean_type_node, cond);
-  return cond;
-}
-
-
-/* Helper function for marking a boolean expression tree as likely.  */
-
-tree
-gfc_likely (tree cond)
-{
-  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);
-  cond = fold_convert (boolean_type_node, cond);
-  return cond;
-}
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 424ce7a..2ed006f 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -577,10 +577,6 @@ void gfc_generate_constructors (void);
 /* Get the string length of an array constructor.  */
 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);
-
 /* Generate a runtime error call.  */
 tree gfc_trans_runtime_error (bool, locus*, const char*, ...);
 
diff --git a/gcc/predict.def b/gcc/predict.def
index 2ce135c..ca58b26 100644
--- a/gcc/predict.def
+++ b/gcc/predict.def
@@ -133,3 +133,19 @@ 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 are used in Fortran. */
+
+/* Branch leading to a run-time warning message are less likely.  */
+DEF_PREDICTOR (PRED_WARN_CALL, "warn call", HITRATE (70), 0)
+
+/* Branch leading to an failure status are unlikely.  */
+DEF_PREDICTOR (PRED_FAIL, "fail", HITRATE(80), 0)
+
+/* Branch belonging to a zero-sized array or absent argument are unlikely.  */
+DEF_PREDICTOR (PRED_ZERO, "zero", HITRATE(80), 0)
+
+/* Branch leading to an overflow are extremely unlikely.  */
+DEF_PREDICTOR (PRED_OVERFLOW, "overflow", PROB_VERY_LIKELY,
+	       PRED_FLAG_FIRST_MATCH)
