Re: [Patch, fortran] PR35339 Optimize implied do loops in io statements

[Renlin Li]

171.swim fails on aarch64-linux as well. I dis a bisect and confirm it's r248877 causing 
the miscompare.


Regards,
Renlin

On 06/06/17 12:05, Markus Trippelsdorf wrote:

On 2017.06.05 at 22:39 +0200, Nicolas Koenig wrote:

With all the style fixes committed as r248877.


171_swim fails now. I didn't bisect, but I suspect your revision.

Re: [Patch, fortran] PR35339 Optimize implied do loops in io statements

[Markus Trippelsdorf]

On 2017.06.05 at 22:39 +0200, Nicolas Koenig wrote:
> With all the style fixes committed as r248877.

171_swim fails now. I didn't bisect, but I suspect your revision.

-- 
Markus

Re: [Patch, fortran] PR35339 Optimize implied do loops in io statements

[Nicolas Koenig]

With all the style fixes committed as r248877.

Thanks for the review.

Nicolas


On 06/03/2017 06:25 PM, Jerry DeLisle wrote:

On 06/03/2017 06:48 AM, Nicolas Koenig wrote:

Hello everyone,

here is a version of the patch that includes a workaround for PR 80960. I have
also included a separate test case for the failure that Dominique detected. The
style issues should be fixed.

Regression-tested. OK for trunk?


Yes, OK.

Thanks for the work.

Jerry

Re: [Patch, fortran] PR35339 Optimize implied do loops in io statements

[Bernhard Reutner-Fischer]

On Sat, Jun 03, 2017 at 09:25:31AM -0700, Jerry DeLisle wrote:
> On 06/03/2017 06:48 AM, Nicolas Koenig wrote:
> > Hello everyone,
> > 
> > here is a version of the patch that includes a workaround for PR 80960. I 
> > have
> > also included a separate test case for the failure that Dominique detected. 
> > The
> > style issues should be fixed.
> > 
> > Regression-tested. OK for trunk?
> > 
> 
> Yes, OK.

There still are plenty of coding-style issues (see below).
Can you please rectify them before committing?

Also you change gfc-internals.texi without a ChangeLog entry. I guess
this was an accident?

thanks,

$ contrib/check_GNU_style.sh /tmp/p9.diff 

Blocks of 8 spaces should be replaced with tabs.
40:+break;
55:+return false;
61:+{
64:+  curr->block->next = NULL;
65:+  gfc_free_statements(curr);
70:+}
92:+  || ref->u.ar.dimen_type[i] != DIMEN_ELEMENT)
93:+return false;
98:+{
111:+  iters[i] = stack_top->iter;
116:+case EXPR_CONSTANT:
120:+  switch (start->value.op.op)
125:+   std::swap(start->value.op.op1, start->value.op.op2);
130:+ || start->value.op.op1->ref)
131:+   return false;
132:+  if (!stack_top || !stack_top->iter 
135:+   return false;
146:+}
160:+continue;
163:+{
174:+  break;
214:+{
215:+  curr->next = prev->next->next;
216:+  prev->next = curr;
219:+{
220:+  curr->next = stack_top->code->block->next->next->next;
253:+{
254:+  first.prev = 
260:+}

Trailing whitespace.
18:+   
20:+ 
22:+ 
25:+static bool 
28:+  gfc_code *curr; 
44:+   
94:+  
106:+ if (!stack_top || !stack_top->iter 
108:+   iters[i] = NULL; 
128:+ if ((start->value.op.op1->expr_type!= EXPR_VARIABLE 
132:+  if (!stack_top || !stack_top->iter 
133:+ || stack_top->iter->var->symtree 
136:+ iters[i] = stack_top->iter; 
152:+  new_e->rank = future_rank; 
176:+ new_e->ref->u.ar.dimen_type[i] = DIMEN_RANGE; 
218:+  else 
244:+  
249:+  

Dot, space, space, new sentence.
17:+   optimize by replacing do loops with their analog array slices. For 
example:

There should be exactly one space between function name and parenthesis.
26:+traverse_io_block(gfc_code *code, bool *has_reached, gfc_code *prev)
60:+  if (traverse_io_block(curr->block->next, has_reached, prev))
65:+  gfc_free_statements(curr);
74:+  gcc_assert(curr->op == EXEC_TRANSFER);
96:+  gfc_simplify_expr(start, 0);
125:+   std::swap(start->value.op.op1, start->value.op.op2);
126:+ gcc_fallthrough();
150:+  new_e = gfc_copy_expr(curr->expr1);
154:+new_e->shape = gfc_get_shape(new_e->rank);
165:+ gfc_internal_error("bad expression");
170:+ gfc_free_expr(new_e->ref->u.ar.start[i]);
171:+ new_e->ref->u.ar.start[i] = gfc_copy_expr(iters[i]->start);
172:+ new_e->ref->u.ar.end[i] = gfc_copy_expr(iters[i]->end);
173:+ new_e->ref->u.ar.stride[i] = gfc_copy_expr(iters[i]->step);
178:+ gfc_free_expr(new_e->ref->u.ar.start[i]);
179:+ expr = gfc_copy_expr(start);
180:+ expr->value.op.op1 = gfc_copy_expr(iters[i]->start);
182:+ gfc_simplify_expr(new_e->ref->u.ar.start[i], 0);
183:+ expr = gfc_copy_expr(start);
184:+ expr->value.op.op1 = gfc_copy_expr(iters[i]->end);
186:+ gfc_simplify_expr(new_e->ref->u.ar.end[i], 0);
187:+ switch(start->value.op.op)
191:+ new_e->ref->u.ar.stride[i] = gfc_copy_expr(iters[i]->step);
194:+ expr = gfc_copy_expr(start);
195:+ expr->value.op.op1 = gfc_copy_expr(iters[i]->step);
197:+ gfc_simplify_expr(new_e->ref->u.ar.stride[i], 0);
200:+ gfc_internal_error("bad op");
204:+ gfc_internal_error("bad expression");
258:+ traverse_io_block((*curr)->block->next, , prev);

> 
> Thanks for the work.
> 
> Jerry

Re: [Patch, fortran] PR35339 Optimize implied do loops in io statements

[Jerry DeLisle]

On 06/03/2017 06:48 AM, Nicolas Koenig wrote:
> Hello everyone,
> 
> here is a version of the patch that includes a workaround for PR 80960. I have
> also included a separate test case for the failure that Dominique detected. 
> The
> style issues should be fixed.
> 
> Regression-tested. OK for trunk?
> 

Yes, OK.

Thanks for the work.

Jerry

Re: [Patch, fortran] PR35339 Optimize implied do loops in io statements

[Nicolas Koenig]

Hello everyone,

here is a version of the patch that includes a workaround for PR 80960. 
I have also included a separate test case for the failure that Dominique 
detected. The style issues should be fixed.


Regression-tested. OK for trunk?

Nicolas

Changelog:

2017-06-03  Nicolas Koenig  

PR fortran/35339
* frontend-passes.c (traverse_io_block): New function.
(simplify_io_impl_do): New function.
(optimize_namespace): Invoke gfc_code_walker with
simplify_io_impl_do.

2017-06-03  Nicolas Koenig  

PR fortran/35339
* gfortran.dg/implied_do_io_1.f90: New Test.
* gfortran.dg/implied_do_io_2.f90: New Test.


Index: frontend-passes.c
===
--- frontend-passes.c	(Revision 248553)
+++ frontend-passes.c	(Arbeitskopie)
@@ -1064,6 +1064,263 @@ convert_elseif (gfc_code **c, int *walk_subtrees A
   return 0;
 }
 
+struct do_stack
+{
+  struct do_stack *prev;
+  gfc_iterator *iter;
+  gfc_code *code;
+} *stack_top;
+
+/* Recursively traverse the block of a WRITE or READ statement, and maybe
+   optimize by replacing do loops with their analog array slices. For example:
+   
+ write (*,*) (a(i), i=1,4)
+ 
+   is replaced with
+ 
+ write (*,*) a(1:4:1) .  */
+
+static bool 
+traverse_io_block(gfc_code *code, bool *has_reached, gfc_code *prev)
+{
+  gfc_code *curr; 
+  gfc_expr *new_e, *expr, *start;
+  gfc_ref *ref;
+  struct do_stack ds_push;
+  int i, future_rank = 0;
+  gfc_iterator *iters[GFC_MAX_DIMENSIONS];
+  gfc_expr *e;
+
+  /* Find the first transfer/do statement.  */
+  for (curr = code; curr; curr = curr->next)
+{
+  if (curr->op == EXEC_DO || curr->op == EXEC_TRANSFER)
+break;
+}
+
+  /* Ensure it is the only transfer/do statement because cases like
+   
+ write (*,*) (a(i), b(i), i=1,4)
+
+ cannot be optimized.  */
+
+  if (!curr || curr->next)
+return false;
+
+  if (curr->op == EXEC_DO)
+{
+  if (curr->ext.iterator->var->ref)
+return false;
+  ds_push.prev = stack_top;
+  ds_push.iter = curr->ext.iterator;
+  ds_push.code = curr;
+  stack_top = _push;
+  if (traverse_io_block(curr->block->next, has_reached, prev))
+{
+	  if (curr != stack_top->code && !*has_reached)
+	{
+  curr->block->next = NULL;
+  gfc_free_statements(curr);
+	}
+	  else
+	*has_reached = true;
+	  return true;
+}
+  return false;
+}
+
+  gcc_assert(curr->op == EXEC_TRANSFER);
+
+  /* FIXME: Workaround for PR 80945 - array slices with deferred character
+ lenghts do not work.  Remove this section when the PR is fixed.  */
+  e = curr->expr1;
+  if (e->expr_type == EXPR_VARIABLE && e->ts.type == BT_CHARACTER
+  && e->ts.deferred)
+return false;
+  /* End of section to be removed.  */
+
+  ref = e->ref;
+  if (!ref || ref->type != REF_ARRAY || ref->u.ar.codimen != 0 || ref->next)
+return false;
+
+  /* Find the iterators belonging to each variable and check conditions.  */
+  for (i = 0; i < ref->u.ar.dimen; i++)
+{
+  if (!ref->u.ar.start[i] || ref->u.ar.start[i]->ref
+  || ref->u.ar.dimen_type[i] != DIMEN_ELEMENT)
+return false;
+  
+  start = ref->u.ar.start[i];
+  gfc_simplify_expr(start, 0);
+  switch (start->expr_type)
+{
+	case EXPR_VARIABLE:
+
+	  /* write (*,*) (a(i), i=a%b,1) not handled yet.  */
+	  if (start->ref)
+	return false;
+
+	  /*  Check for (a(k), i=1,4) or ((a(j, i), i=1,4), j=1,4).  */
+	  if (!stack_top || !stack_top->iter 
+	  || stack_top->iter->var->symtree != start->symtree)
+	iters[i] = NULL; 
+	  else
+	{
+  iters[i] = stack_top->iter;
+	  stack_top = stack_top->prev;
+	  future_rank++;
+	}
+	  break;
+case EXPR_CONSTANT:
+	  iters[i] = NULL;
+	  break;
+	case EXPR_OP:
+  switch (start->value.op.op)
+	{
+	case INTRINSIC_PLUS:
+	case INTRINSIC_TIMES:
+	  if (start->value.op.op1->expr_type != EXPR_VARIABLE)
+	std::swap(start->value.op.op1, start->value.op.op2);
+	  gcc_fallthrough();
+	case INTRINSIC_MINUS:
+	  if ((start->value.op.op1->expr_type!= EXPR_VARIABLE 
+		   && start->value.op.op2->expr_type != EXPR_CONSTANT)
+	  || start->value.op.op1->ref)
+	return false;
+  if (!stack_top || !stack_top->iter 
+		  || stack_top->iter->var->symtree 
+		  != start->value.op.op1->symtree)
+	return false;
+	  iters[i] = stack_top->iter; 
+	  stack_top = stack_top->prev;
+	  break;
+	default:
+	  return false;
+	}
+	  future_rank++;
+	  break;
+	default:
+	  return false;
+}
+}
+
+  /* Create new expr.  */
+  new_e = gfc_copy_expr(curr->expr1);
+  new_e->expr_type = EXPR_VARIABLE;
+  new_e->rank = future_rank; 
+  if (curr->expr1->shape)
+new_e->shape = 

Re: [Patch, fortran] PR35339 Optimize implied do loops in io statements

[Dominique d'Humières]

> Le 1 juin 2017 à 16:19, Dominique d'Humières  a écrit :
> 
> I see
> 
> FAIL: gfortran.dg/deferred_character_2.f90   -O1  execution test
> FAIL: gfortran.dg/deferred_character_2.f90   -O2  execution test
> FAIL: gfortran.dg/deferred_character_2.f90   -O3 -fomit-frame-pointer 
> -funroll-loops -fpeel-loops -ftracer -finline-functions  execution test
> FAIL: gfortran.dg/deferred_character_2.f90   -O3 -g  execution test
> FAIL: gfortran.dg/deferred_character_2.f90   -Os  execution test
> 
> Dominique

Reduced test

PROGRAM hello

IMPLICIT NONE

CHARACTER(LEN=:),DIMENSION(:),ALLOCATABLE :: array_lineas
CHARACTER(LEN=:),DIMENSION(:),ALLOCATABLE :: array_copia
character (3), dimension (2) :: array_fijo = ["abc","def"]
character (100) :: buffer
INTEGER :: largo , cant_lineas , i

write (buffer, "(2a3)") array_fijo

largo = LEN (array_fijo)

cant_lineas = size (array_fijo, 1)

ALLOCATE(CHARACTER(LEN=largo) :: array_lineas(cant_lineas))

READ(buffer,"(2a3)") (array_lineas(i),i=1,cant_lineas)

print *, array_lineas
print *, array_fijo
 if (any (array_lineas .ne. array_fijo)) call abort

END PROGRAM

Dominique

Re: [Patch, fortran] PR35339 Optimize implied do loops in io statements

[Dominique d'Humières]

> Le 1 juin 2017 à 11:30, Dominique d'Humières  a écrit :
> 
> 
>> Le 31 mai 2017 à 21:03, Nicolas Koenig  a écrit :
>> 
>> Hello Dominique,
>> 
>> attached is the next try, this time without stupidities (I hope). Both test 
>> cases you posted don't ICE anymore.
>> 
>> Ok for trunk?
>> 
>> Nicolas
>> 
> 
> Preliminary tests look OK, full testing in progress.
> 
> Thanks,
> 
> Dominique
> 

I see

FAIL: gfortran.dg/deferred_character_2.f90   -O1  execution test
FAIL: gfortran.dg/deferred_character_2.f90   -O2  execution test
FAIL: gfortran.dg/deferred_character_2.f90   -O3 -fomit-frame-pointer 
-funroll-loops -fpeel-loops -ftracer -finline-functions  execution test
FAIL: gfortran.dg/deferred_character_2.f90   -O3 -g  execution test
FAIL: gfortran.dg/deferred_character_2.f90   -Os  execution test

Dominique

Re: [Patch, fortran] PR35339 Optimize implied do loops in io statements

[Dominique d'Humières]

> Le 31 mai 2017 à 21:03, Nicolas Koenig  a écrit :
> 
> Hello Dominique,
> 
> attached is the next try, this time without stupidities (I hope). Both test 
> cases you posted don't ICE anymore.
> 
> Ok for trunk?
> 
> Nicolas
> 

Preliminary tests look OK, full testing in progress.

Thanks,

Dominique

Re: [Patch, fortran] PR35339 Optimize implied do loops in io statements

[Bernhard Reutner-Fischer]

On 31 May 2017 at 21:03, Nicolas Koenig  wrote:
> Hello Dominique,
>
> attached is the next try, this time without stupidities (I hope). Both test
> cases you posted don't ICE anymore.
>
> Ok for trunk?

Please check contrib/check_GNU_style.sh /tmp/p8.diff
and let me point you to contrib/vimrc

Furthermore:

+/* Recursivly traverse the block of a WRITE or READ statement, and, can it be
+   optimized, do so. It optimizes it by replacing do loops with their analog
+   array slices. For example:

s/Recursivly/Recursively

Maybe:
Recursively traverse the block of a WRITE or READ statement and maybe
optimize it by ...

+  if (curr->expr1->shape)
+{
+  new_e->shape = gfc_get_shape(new_e->rank);
+}
+
+
No curly braces around single stmt if-bodies.
Excess vertical space.

+  if (!(*code)->block || ((*code)->block->op != EXEC_WRITE
+  && (*code)->block->op != EXEC_READ))

break line on ||
  if (!(*code)->block
  || ((*code)->block->op != EXEC_WRITE
  && (*code)->block->op != EXEC_READ))

thanks,

Re: [Patch, fortran] PR35339 Optimize implied do loops in io statements

[Nicolas Koenig]

Hello Dominique,

attached is the next try, this time without stupidities (I hope). Both 
test cases you posted don't ICE anymore.


Ok for trunk?

Nicolas

Regression tested for x86_64-pc-linux-gnu.

Changelog (still the same):
2017-05-27  Nicolas Koenig  

PR fortran/35339
* frontend-passes.c (traverse_io_block): New function.
(simplify_io_impl_do): New function.
(optimize_namespace): Invoke gfc_code_walker with
simplify_io_impl_do.

2017-05-27  Nicolas Koenig  

PR fortran/35339
* gfortran.dg/implied_do_io_1.f90: New Test.

On 05/31/2017 05:49 PM, Dominique d'Humières wrote:

Le 31 mai 2017 à 17:40, Dominique d'Humières  a écrit :

If I am not mistaken, compiling the following code with the patch applied

simpler test

   print *,(huge(0),i=1,6)
!  print*,(i,i=1,6)
!  print*,(i,i=1,6,1)
   end


gives an ICE.

TIA

Dominique


Index: frontend-passes.c
===
--- frontend-passes.c	(revision 248539)
+++ frontend-passes.c	(working copy)
@@ -1060,6 +1060,257 @@ convert_elseif (gfc_code **c, int *walk_subtrees A
   return 0;
 }
 
+struct do_stack
+{
+  struct do_stack *prev;
+  gfc_iterator *iter;
+  gfc_code *code;
+} *stack_top;
+
+/* Recursivly traverse the block of a WRITE or READ statement, and, can it be
+   optimized, do so. It optimizes it by replacing do loops with their analog
+   array slices. For example:
+   
+ write (*,*) (a(i), i=1,4)
+ 
+   is replaced with
+ 
+ write (*,*) a(1:4:1) .  */
+
+static bool 
+traverse_io_block(gfc_code *code, bool *has_reached, gfc_code *prev)
+{
+  gfc_code *curr; 
+  gfc_expr *new_e, *expr, *start;
+  gfc_ref *ref;
+  struct do_stack ds_push;
+  int i, future_rank = 0;
+  gfc_iterator *iters[GFC_MAX_DIMENSIONS];
+
+  /* Find the first transfer/do statement.  */
+  for (curr = code; curr; curr = curr->next)
+{
+  if (curr->op == EXEC_DO || curr->op == EXEC_TRANSFER)
+break;
+}
+
+  /* Ensure it is the only transfer/do statement because cases like
+   
+   write (*,*) (a(i), b(i), i=1,4)
+
+ cannot be optimized.  */
+
+  if (!curr || curr->next)
+return false;
+
+  if (curr->op == EXEC_DO)
+{
+  if (curr->ext.iterator->var->ref)
+return false;
+  ds_push.prev = stack_top;
+  ds_push.iter = curr->ext.iterator;
+  ds_push.code = curr;
+  stack_top = _push;
+  if (traverse_io_block(curr->block->next, has_reached, prev))
+{
+	  if (curr != stack_top->code && !*has_reached)
+	{
+  curr->block->next = NULL;
+  gfc_free_statements(curr);
+	}
+	  else
+	*has_reached = true;
+	  return true;
+}
+  return false;
+}
+
+  gcc_assert(curr->op == EXEC_TRANSFER);
+
+  ref = curr->expr1->ref;
+  if (!ref || ref->type != REF_ARRAY || ref->u.ar.codimen != 0 || ref->next)
+return false;
+
+  /* Find the iterators belonging to each variable and check conditions.  */
+  for (i = 0; i < ref->u.ar.dimen; i++)
+{
+  if (!ref->u.ar.start[i] || ref->u.ar.start[i]->ref
+  || ref->u.ar.dimen_type[i] != DIMEN_ELEMENT)
+return false;
+  
+  start = ref->u.ar.start[i];
+  gfc_simplify_expr(start, 0);
+  switch (start->expr_type)
+{
+	case EXPR_VARIABLE:
+
+	  /* write (*,*) (a(i), i=a%b,1) not handled yet.  */
+	  if (start->ref)
+	return false;
+
+	  /*  Check for (a(k), i=1,4) or ((a(j, i), i=1,4), j=1,4).  */
+	  if (!stack_top || !stack_top->iter 
+	 || stack_top->iter->var->symtree != start->symtree)
+	iters[i] = NULL; 
+	  else
+	{
+  iters[i] = stack_top->iter;
+	  stack_top = stack_top->prev;
+	  future_rank++;
+	}
+	  break;
+case EXPR_CONSTANT:
+	  iters[i] = NULL;
+	  break;
+	case EXPR_OP:
+  switch (start->value.op.op)
+	{
+	case INTRINSIC_PLUS:
+	case INTRINSIC_TIMES:
+	  if (start->value.op.op1->expr_type != EXPR_VARIABLE)
+	std::swap(start->value.op.op1, start->value.op.op2);
+	gcc_fallthrough();
+	case INTRINSIC_MINUS:
+	  if ((start->value.op.op1->expr_type!= EXPR_VARIABLE 
+	&& start->value.op.op2->expr_type != EXPR_CONSTANT)
+	  || start->value.op.op1->ref)
+	return false;
+  if (!stack_top || !stack_top->iter 
+	 || stack_top->iter->var->symtree 
+		!= start->value.op.op1->symtree)
+	return false;
+	  iters[i] = stack_top->iter; 
+	  stack_top = stack_top->prev;
+	  break;
+	default:
+	  return false;
+	}
+	future_rank++;
+	  break;
+	default:
+	  return false;
+}
+}
+
+  /* Create new expr.  */
+  new_e = gfc_copy_expr(curr->expr1);
+  new_e->expr_type = EXPR_VARIABLE;
+  new_e->rank = future_rank; 
+  if (curr->expr1->shape)
+{
+  new_e->shape = gfc_get_shape(new_e->rank);
+}

Re: [Patch, fortran] PR35339 Optimize implied do loops in io statements

[Dominique d'Humières]

> Le 31 mai 2017 à 17:40, Dominique d'Humières  a écrit :
> 
> If I am not mistaken, compiling the following code with the patch applied

simpler test

  print *,(huge(0),i=1,6)
!  print*,(i,i=1,6)
!  print*,(i,i=1,6,1)
  end

> 
> gives an ICE.
> 
> TIA
> 
> Dominique

Re: [Patch, fortran] PR35339 Optimize implied do loops in io statements

[Dominique d'Humières]

If I am not mistaken, compiling the following code with the patch applied

program test_ivs
  use iso_varying_string
  implicit none

  type(varying_string),dimension(:,:),allocatable :: array2d
  type(varying_string) :: extra
  integer :: i,j

  allocate(array2d(2,3))

  extra = "four"

  array2d(:,:) = reshape((/ var_str("1"), &
   var_str("2"), var_str("3"), &
   extra, var_str("5"), &
   var_str("six") /), (/ 2, 3 /))


  print *,"array2d second ",ubound(array2d),(("'"//char(array2d(i,j))//"' 
",i=1,size(array2d,1)),j=1,size(array2d,2))

end program test_ivs

gives an ICE.

TIA

Dominique

> Le 31 mai 2017 à 08:16, Bernhard Reutner-Fischer  a 
> écrit :
> 
> On 29 May 2017 17:49:30 CEST, Nicolas Koenig  wrote:
>> Hello Dominique,
>> 
>> mea culpa, their was a bit confusion with the file being open in emacs
>> and vi at the same time. Attached is the new patch with the #define
>> removed.

Re: [Patch, fortran] PR35339 Optimize implied do loops in io statements

[Bernhard Reutner-Fischer]

On 29 May 2017 17:49:30 CEST, Nicolas Koenig  wrote:
>Hello Dominique,
>
>mea culpa, their was a bit confusion with the file being open in emacs
>and vi at the same time. Attached is the new patch with the #define
>removed.


+static int
+simplify_io_impl_do (gfc_code **code, int *walk_subtrees,
+  void *data ATTRIBUTE_UNUSED)
+{
+  gfc_code **curr, *prev = NULL;
+  struct do_stack write, first;
+  bool b = false;
+  *walk_subtrees = 1;
+  if (!(*code)->block || ((*code)->block->op != EXEC_WRITE
+  && (*code)->block->op != EXEC_READ))
+return 0;
+  
+  *walk_subtrees = 0;
+  write.prev = NULL;
+  write.iter = NULL;
+  write.code = *code;
+  
+  for (curr = &(*code)->block; *curr; curr = &(*curr)->next)
+{
+  if ((*curr)->op == EXEC_DO)
+{
+  first.prev = 
+ first.iter = (*curr)->ext.iterator;
+ first.code = *curr;
+ stack_top = 

It seems indentation is off above.
thanks,

+ traverse_io_block((*curr)->block->next, , prev);
+ stack_top = NULL;
+}
+  prev = *curr;
+}
+  return 0;
+}

Re: [Patch, fortran] PR35339 Optimize implied do loops in io statements

[Dominique d'Humières]

> Le 29 mai 2017 à 17:49, Nicolas Koenig  a écrit :
> 
> Hello Dominique,
> 
> mea culpa, their was a bit confusion with the file being open in emacs
> and vi at the same time. Attached is the new patch with the #define removed.
> 
> Nicolas
> 

Thanks for the quick fix!

Testing in progress

Dominique

Re: [Patch, fortran] PR35339 Optimize implied do loops in io statements

[Nicolas Koenig]

Hello Dominique,

mea culpa, their was a bit confusion with the file being open in emacs
and vi at the same time. Attached is the new patch with the #define removed.

Nicolas


On 05/29/2017 05:32 PM, Dominique d'Humières wrote:

Hi Nicolas,

Updating gfortran with your patch fails with

../../work/gcc/fortran/frontend-passes.c: In function 'bool 
traverse_io_block(gfc_code*, bool*, gfc_code*)':
../../work/gcc/fortran/frontend-passes.c:1067:20: error: expected 
unqualified-id before '(' token
  #define swap(x, y) (x) ^= (y), (y) ^= (x), (x) ^= (y);
 ^
../../work/gcc/fortran/frontend-passes.c:1180:15: note: in expansion of macro 
'swap'
   std::swap(start->value.op.op1, start->value.op.op2);
^~~~
../../work/gcc/fortran/frontend-passes.c:1067:36: error: invalid operands of 
types 'gfc_expr*' and 'gfc_expr*' to binary 'operator^'
  #define swap(x, y) (x) ^= (y), (y) ^= (x), (x) ^= (y);
 ^~
../../work/gcc/fortran/frontend-passes.c:1180:15: note: in expansion of macro 
'swap'
   std::swap(start->value.op.op1, start->value.op.op2);
^~~~
../../work/gcc/fortran/frontend-passes.c:1067:41: error:   in evaluation of 
'operator^=(struct gfc_expr*, struct gfc_expr*)'
  #define swap(x, y) (x) ^= (y), (y) ^= (x), (x) ^= (y);
  ^
../../work/gcc/fortran/frontend-passes.c:1180:15: note: in expansion of macro 
'swap'
   std::swap(start->value.op.op1, start->value.op.op2);
^~~~
../../work/gcc/fortran/frontend-passes.c:1067:48: error: invalid operands of 
types 'gfc_expr*' and 'gfc_expr*' to binary 'operator^'
  #define swap(x, y) (x) ^= (y), (y) ^= (x), (x) ^= (y);
 ^~
../../work/gcc/fortran/frontend-passes.c:1180:15: note: in expansion of macro 
'swap'
   std::swap(start->value.op.op1, start->value.op.op2);
^~~~
../../work/gcc/fortran/frontend-passes.c:1067:53: error:   in evaluation of 
'operator^=(struct gfc_expr*, struct gfc_expr*)'
  #define swap(x, y) (x) ^= (y), (y) ^= (x), (x) ^= (y);
  ^
../../work/gcc/fortran/frontend-passes.c:1180:15: note: in expansion of macro 
'swap'
   std::swap(start->value.op.op1, start->value.op.op2);
^~~~

TIA

Dominique



Index: frontend-passes.c
===
--- frontend-passes.c	(revision 248539)
+++ frontend-passes.c	(working copy)
@@ -1060,6 +1060,256 @@ convert_elseif (gfc_code **c, int *walk_subtrees A
   return 0;
 }
 
+struct do_stack
+{
+  struct do_stack *prev;
+  gfc_iterator *iter;
+  gfc_code *code;
+} *stack_top;
+
+/* Recursivly traverse the block of a WRITE or READ statement, and, can it be
+   optimized, do so. It optimizes it by replacing do loops with their analog
+   array slices. For example:
+   
+ write (*,*) (a(i), i=1,4)
+ 
+   is replaced with
+ 
+ write (*,*) a(1:4:1) .  */
+
+static bool 
+traverse_io_block(gfc_code *code, bool *has_reached, gfc_code *prev)
+{
+  gfc_code *curr; 
+  gfc_expr *new_e, *expr, *start;
+  gfc_ref *ref;
+  struct do_stack ds_push;
+  int i, future_rank = 0;
+  gfc_iterator *iters[GFC_MAX_DIMENSIONS];
+
+  /* Find the first transfer/do statement.  */
+  for (curr = code; curr; curr = curr->next)
+{
+  if (curr->op == EXEC_DO || curr->op == EXEC_TRANSFER)
+break;
+}
+
+  /* Ensure it is the only transfer/do statement because cases like
+   
+   write (*,*) (a(i), b(i), i=1,4)
+
+ cannot be optimized.  */
+
+  if (!curr || curr->next)
+return false;
+
+  if (curr->op == EXEC_DO)
+{
+  if (curr->ext.iterator->var->ref)
+return false;
+  ds_push.prev = stack_top;
+  ds_push.iter = curr->ext.iterator;
+  ds_push.code = curr;
+  stack_top = _push;
+  if (traverse_io_block(curr->block->next, has_reached, prev))
+{
+	  if (curr != stack_top->code && !*has_reached)
+	{
+  curr->block->next = NULL;
+  gfc_free_statements(curr);
+	}
+	  else
+	*has_reached = true;
+	  return true;
+}
+  return false;
+}
+
+  gcc_assert(curr->op == EXEC_TRANSFER);
+
+  if (curr->expr1->symtree->n.sym->attr.allocatable)
+return false;
+
+  ref = curr->expr1->ref;
+  if (!ref || ref->type != REF_ARRAY || ref->u.ar.codimen != 0)
+return false;
+
+  /* Find the iterators belonging to each variable and check conditions.  */
+  for (i = 0; i < ref->u.ar.dimen; i++)
+{
+  if (!ref->u.ar.start[i] || ref->u.ar.start[i]->ref
+  || ref->u.ar.dimen_type[i] != DIMEN_ELEMENT)
+return false;
+  
+  start = ref->u.ar.start[i];
+  gfc_simplify_expr(start, 0);
+  switch (start->expr_type)
+{
+	case EXPR_VARIABLE:
+
+	  /* write (*,*) (a(i), i=a%b,1) not handled yet.  */
+	  if (start->ref)
+	return 

Re: [Patch, fortran] PR35339 Optimize implied do loops in io statements

[Dominique d'Humières]

Hi Nicolas,

Updating gfortran with your patch fails with

../../work/gcc/fortran/frontend-passes.c: In function 'bool 
traverse_io_block(gfc_code*, bool*, gfc_code*)':
../../work/gcc/fortran/frontend-passes.c:1067:20: error: expected 
unqualified-id before '(' token
 #define swap(x, y) (x) ^= (y), (y) ^= (x), (x) ^= (y);
^
../../work/gcc/fortran/frontend-passes.c:1180:15: note: in expansion of macro 
'swap'
  std::swap(start->value.op.op1, start->value.op.op2);
   ^~~~
../../work/gcc/fortran/frontend-passes.c:1067:36: error: invalid operands of 
types 'gfc_expr*' and 'gfc_expr*' to binary 'operator^'
 #define swap(x, y) (x) ^= (y), (y) ^= (x), (x) ^= (y);
^~
../../work/gcc/fortran/frontend-passes.c:1180:15: note: in expansion of macro 
'swap'
  std::swap(start->value.op.op1, start->value.op.op2);
   ^~~~
../../work/gcc/fortran/frontend-passes.c:1067:41: error:   in evaluation of 
'operator^=(struct gfc_expr*, struct gfc_expr*)'
 #define swap(x, y) (x) ^= (y), (y) ^= (x), (x) ^= (y);
 ^
../../work/gcc/fortran/frontend-passes.c:1180:15: note: in expansion of macro 
'swap'
  std::swap(start->value.op.op1, start->value.op.op2);
   ^~~~
../../work/gcc/fortran/frontend-passes.c:1067:48: error: invalid operands of 
types 'gfc_expr*' and 'gfc_expr*' to binary 'operator^'
 #define swap(x, y) (x) ^= (y), (y) ^= (x), (x) ^= (y);
^~
../../work/gcc/fortran/frontend-passes.c:1180:15: note: in expansion of macro 
'swap'
  std::swap(start->value.op.op1, start->value.op.op2);
   ^~~~
../../work/gcc/fortran/frontend-passes.c:1067:53: error:   in evaluation of 
'operator^=(struct gfc_expr*, struct gfc_expr*)'
 #define swap(x, y) (x) ^= (y), (y) ^= (x), (x) ^= (y);
 ^
../../work/gcc/fortran/frontend-passes.c:1180:15: note: in expansion of macro 
'swap'
  std::swap(start->value.op.op1, start->value.op.op2);
   ^~~~

TIA

Dominique

Re: [Patch, fortran] PR35339 Optimize implied do loops in io statements

[Jerry DeLisle]

On 05/27/2017 12:49 PM, Nicolas Koenig wrote:

Hello everyone,

attached is a patch to simplify implied do loops in io statements by replacing 
them with their respective array slices. For example "WRITE (*,*) (a(i), 
i=1,4,2)" becomes "WRITE (*,*) a(1:4:2)".


Ok for trunk?



Thanks for patch. Could you do some timing performance tests with and without 
the patch on large arrays and see if we gain anything?


Also, we should expand the test case to include implied do loops in read 
statements. You could probably just rewind the file, copy down the WRITEs and 
change them to READs or similar and check results.


While doing some checks myself I noticed some odd behavior and found PR53029. I 
posted a patch, but what caught my attention was the implied do version was 
faster than the array version. (about .89 sec vs 6 sec)


So with my patch there I am now getting (.89 sec vs .007 sec)

This prompted me to have you check some performance cases.

Thanks for additional feedback,

Jerry

[Patch, fortran] PR35339 Optimize implied do loops in io statements

[Nicolas Koenig]

Hello everyone,

attached is a patch to simplify implied do loops in io statements by 
replacing them with their respective array slices. For example "WRITE 
(*,*) (a(i), i=1,4,2)" becomes "WRITE (*,*) a(1:4:2)".


Ok for trunk?

Nicolas

Regression tested for x85_64-pc-linux-gnu.

Changelog:
2017-05-27  Nicolas Koenig  

PR fortran/35339
* frontend-passes.c (traverse_io_block): New function.
(simplify_io_impl_do): New function.
(optimize_namespace): Invoke gfc_code_walker with
simplify_io_impl_do.

2017-05-27  Nicolas Koenig  

PR fortran/35339
* gfortran.dg/implied_do_io_1.f90: New Test.

Index: frontend-passes.c
===
--- frontend-passes.c	(revision 248539)
+++ frontend-passes.c	(working copy)
@@ -1060,6 +1060,258 @@ convert_elseif (gfc_code **c, int *walk_subtrees A
   return 0;
 }
 
+#define swap(x, y) (x) ^= (y), (y) ^= (x), (x) ^= (y);
+
+struct do_stack
+{
+  struct do_stack *prev;
+  gfc_iterator *iter;
+  gfc_code *code;
+} *stack_top;
+
+/* Recursivly traverse the block of a WRITE or READ statement, and, can it be
+   optimized, do so. It optimizes it by replacing do loops with their analog
+   array slices. For example:
+   
+ write (*,*) (a(i), i=1,4)
+ 
+   is replaced with
+ 
+ write (*,*) a(1:4:1) .  */
+
+static bool 
+traverse_io_block(gfc_code *code, bool *has_reached, gfc_code *prev)
+{
+  gfc_code *curr; 
+  gfc_expr *new_e, *expr, *start;
+  gfc_ref *ref;
+  struct do_stack ds_push;
+  int i, future_rank = 0;
+  gfc_iterator *iters[GFC_MAX_DIMENSIONS];
+
+  /* Find the first transfer/do statement.  */
+  for (curr = code; curr; curr = curr->next)
+{
+  if (curr->op == EXEC_DO || curr->op == EXEC_TRANSFER)
+break;
+}
+
+  /* Ensure it is the only transfer/do statement because cases like
+   
+   write (*,*) (a(i), b(i), i=1,4)
+
+ cannot be optimized.  */
+
+  if (!curr || curr->next)
+return false;
+
+  if (curr->op == EXEC_DO)
+{
+  if (curr->ext.iterator->var->ref)
+return false;
+  ds_push.prev = stack_top;
+  ds_push.iter = curr->ext.iterator;
+  ds_push.code = curr;
+  stack_top = _push;
+  if (traverse_io_block(curr->block->next, has_reached, prev))
+{
+	  if (curr != stack_top->code && !*has_reached)
+	{
+  curr->block->next = NULL;
+  gfc_free_statements(curr);
+	}
+	  else
+	*has_reached = true;
+	  return true;
+}
+  return false;
+}
+
+  gcc_assert(curr->op == EXEC_TRANSFER);
+
+  if (curr->expr1->symtree->n.sym->attr.allocatable)
+return false;
+
+  ref = curr->expr1->ref;
+  if (!ref || ref->type != REF_ARRAY || ref->u.ar.codimen != 0)
+return false;
+
+  /* Find the iterators belonging to each variable and check conditions.  */
+  for (i = 0; i < ref->u.ar.dimen; i++)
+{
+  if (!ref->u.ar.start[i] || ref->u.ar.start[i]->ref
+  || ref->u.ar.dimen_type[i] != DIMEN_ELEMENT)
+return false;
+  
+  start = ref->u.ar.start[i];
+  gfc_simplify_expr(start, 0);
+  switch (start->expr_type)
+{
+	case EXPR_VARIABLE:
+
+	  /* write (*,*) (a(i), i=a%b,1) not handled yet.  */
+	  if (start->ref)
+	return false;
+
+	  /*  Check for (a(k), i=1,4) or ((a(j, i), i=1,4), j=1,4).  */
+	  if (!stack_top || !stack_top->iter 
+	 || stack_top->iter->var->symtree != start->symtree)
+	iters[i] = NULL; 
+	  else
+	{
+  iters[i] = stack_top->iter;
+	  stack_top = stack_top->prev;
+	  future_rank++;
+	}
+	  break;
+case EXPR_CONSTANT:
+	  iters[i] = NULL;
+	  break;
+	case EXPR_OP:
+  switch (start->value.op.op)
+	{
+	case INTRINSIC_PLUS:
+	case INTRINSIC_TIMES:
+	  if (start->value.op.op1->expr_type != EXPR_VARIABLE)
+	std::swap(start->value.op.op1, start->value.op.op2);
+	__attribute__((fallthrough));
+	case INTRINSIC_MINUS:
+	  if ((start->value.op.op1->expr_type!= EXPR_VARIABLE 
+	&& start->value.op.op2->expr_type != EXPR_CONSTANT)
+	  || start->value.op.op1->ref)
+	return false;
+  if (!stack_top || !stack_top->iter 
+	 || stack_top->iter->var->symtree 
+		!= start->value.op.op1->symtree)
+	return false;
+	  iters[i] = stack_top->iter; 
+	  stack_top = stack_top->prev;
+	  break;
+	default:
+	  return false;
+	}
+	future_rank++;
+	  break;
+	default:
+	  return false;
+}
+}
+
+  /* Create new expr.  */
+  new_e = gfc_copy_expr(curr->expr1);
+  new_e->expr_type = EXPR_VARIABLE;
+  new_e->rank = future_rank; 
+  if (curr->expr1->shape)
+{
+  new_e->shape = gfc_get_shape(new_e->rank);
+}
+
+  /* Assign new starts, ends and strides if necessary.  */
+  for (i = 0; i < ref->u.ar.dimen; i++)
+{
+  if (!iters[i])
+