[patch, fortran] PR32382 missed optimization in internal read

[Jerry DeLisle <jvdelisle at verizon dot net>]

Hi Folks,

Some more quiet time allowed me to see this simple solution.  This modifies the 
DO LOOP code for implied loops in I/O statements (READ and WRITE) by adding a 
simple exit condition at the end of the loop block.  It only comes into play 
while translating I/O statements.

Regression tested on x86_64.  No need for new test case in testsuite.  I have 
attached the case from the PR for convenience.

OK for trunk?

Regards,

Jerry

2010-02-13  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/32382
	* trans-stmt.c (gfc_trans_simple_do): Add optional argument to pass a
	loop exit condition.  Build the loop exit code if present.
	(gfc_trans_do): Likewise.
	* trans-stmt.h: Update function prototype.
	* trans.c (gfc_trans_code): Use NULL_TREE for exit condition in call
	to gfc_trans_do.
	* trans-io.c (build_dt): Look for an EXEC_DO in the next code block.
	If found, build an exit condition that checks the IO result status bits
	in the dtparm structure. Use this condition to translate the implied DO
	loop, adding a runtime error check inside the loop.

Index: trans-stmt.c
===================================================================
--- trans-stmt.c	(revision 156750)
+++ trans-stmt.c	(working copy)
@@ -831,7 +831,7 @@ gfc_trans_block_construct (gfc_code* code)
 
 static tree
 gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar,
-		     tree from, tree to, tree step)
+		     tree from, tree to, tree step, tree exit_cond)
 {
   stmtblock_t body;
   tree type;
@@ -882,6 +882,15 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t
 			       "Loop variable has been modified");
     }
 
+  /* Exit the loop if there is an I/O result condition or error.  */
+  if (exit_cond)
+    {
+      tmp = build1_v (GOTO_EXPR, exit_label);
+      tmp = fold_build3 (COND_EXPR, void_type_node, exit_cond, tmp,
+			 build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&body, tmp);
+    }
+
   /* Evaluate the loop condition.  */
   cond = fold_build2 (EQ_EXPR, boolean_type_node, dovar, to);
   cond = gfc_evaluate_now (cond, &body);
@@ -955,7 +964,7 @@ exit_label:
    because the loop count itself can overflow.  */
 
 tree
-gfc_trans_do (gfc_code * code)
+gfc_trans_do (gfc_code * code, tree exit_cond)
 {
   gfc_se se;
   tree dovar;
@@ -1010,7 +1019,7 @@ tree
   if (TREE_CODE (type) == INTEGER_TYPE
       && (integer_onep (step)
 	|| tree_int_cst_equal (step, integer_minus_one_node)))
-    return gfc_trans_simple_do (code, &block, dovar, from, to, step);
+    return gfc_trans_simple_do (code, &block, dovar, from, to, step, exit_cond);
 
   pos_step = fold_build2 (GT_EXPR, boolean_type_node, step,
 			  fold_convert (type, integer_zero_node));
@@ -1143,6 +1152,15 @@ tree
 			       "Loop variable has been modified");
     }
 
+  /* Exit the loop if there is an I/O result condition or error.  */
+  if (exit_cond)
+    {
+      tmp = build1_v (GOTO_EXPR, exit_label);
+      tmp = fold_build3 (COND_EXPR, void_type_node, exit_cond, tmp,
+			 build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&body, tmp);
+    }
+
   /* Increment the loop variable.  */
   tmp = fold_build2 (PLUS_EXPR, type, dovar, step);
   gfc_add_modify (&body, dovar, tmp);
Index: trans-stmt.h
===================================================================
--- trans-stmt.h	(revision 156750)
+++ trans-stmt.h	(working copy)
@@ -45,7 +45,7 @@ tree gfc_trans_return (gfc_code *);
 tree gfc_trans_if (gfc_code *);
 tree gfc_trans_arithmetic_if (gfc_code *);
 tree gfc_trans_block_construct (gfc_code *);
-tree gfc_trans_do (gfc_code *);
+tree gfc_trans_do (gfc_code *, tree);
 tree gfc_trans_do_while (gfc_code *);
 tree gfc_trans_select (gfc_code *);
 tree gfc_trans_forall (gfc_code *);
Index: trans.c
===================================================================
--- trans.c	(revision 156750)
+++ trans.c	(working copy)
@@ -1172,7 +1172,7 @@ gfc_trans_code (gfc_code * code)
 	  break;
 
 	case EXEC_DO:
-	  res = gfc_trans_do (code);
+	  res = gfc_trans_do (code, NULL_TREE);
 	  break;
 
 	case EXEC_DO_WHILE:
Index: trans-io.c
===================================================================
--- trans-io.c	(revision 156750)
+++ trans-io.c	(working copy)
@@ -1810,8 +1810,26 @@ build_dt (tree function, gfc_code * code)
 
   dt_parm = var;
   dt_post_end_block = &post_end_block;
+  
+  if (code->block->next->op == EXEC_DO
+      && (last_dt == READ || last_dt == WRITE))
+    {
+      tree cond;
+      gfc_st_parameter_field *p = &st_parameter_field[IOPARM_common_flags];
 
-  gfc_add_expr_to_block (&block, gfc_trans_code (code->block->next));
+      tmp = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type,
+			 dt_parm, TYPE_FIELDS (TREE_TYPE (dt_parm)), NULL_TREE);
+      cond = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field),
+			  tmp, p->field, NULL_TREE);
+      cond = fold_build2 (BIT_AND_EXPR, TREE_TYPE (cond),
+			  cond, build_int_cst (TREE_TYPE (cond),
+			  IOPARM_common_libreturn_mask));
+      
+      gfc_add_expr_to_block (&block, gfc_trans_do (code->block->next, cond));
+      gfc_add_expr_to_block (&block, gfc_trans_code (code->block->next->next));
+    }
+  else
+    gfc_add_expr_to_block (&block, gfc_trans_code (code->block->next));
 
   gfc_add_block_to_block (&block, &post_iu_block);
 

C234567
      program internalread
      implicit none
      integer m
CC      parameter(m=100)
      parameter(m=1000000)
      character value*10
      integer i,j,intvalues(m)

      DO j=1,100
        write(value,'(i3,a5)') j," 5 69"
        write(*,*) value
        read(value,*,end=20,err=20) (intvalues(i),i=1,m)
20      write(*,*) j
      ENDDO
      end program internalread