[Patch, fortran] PR35339 Optimize implied do loops in io statements
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 = &ds_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]) +continue; + start = ref->u.ar.start[i]; + s
Re: [Patch, fortran] PR35339 Optimize implied do loops in io statements
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
Re: [Patch, fortran] PR35339 Optimize implied do loops in io statements
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
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 = &ds_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 fa
Re: [Patch, fortran] PR35339 Optimize implied do loops in io statements
> 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
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 = &write; + first.iter = (*curr)->ext.iterator; + first.code = *curr; + stack_top = &first; It seems indentation is off above. thanks, + traverse_io_block((*curr)->block->next, &b, prev); + stack_top = NULL; +} + prev = *curr; +} + return 0; +}
Re: [Patch, fortran] PR35339 Optimize implied do loops in io statements
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
> 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
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 = &ds_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); +} + + + /* Assign new starts, ends and strides if necessary. */ + fo
Re: [Patch, fortran] PR35339 Optimize implied do loops in io statements
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
> 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
> 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
> 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
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 = &ds_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 = gfc_get_shape(new_e->rank); + + /* Assign new starts, ends and
Re: [Patch, fortran] PR35339 Optimize implied do loops in io statements
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
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 = &write; 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, &b, prev); > > Thanks for the work. > > Jerry
Re: [Patch, fortran] PR35339 Optimize implied do loops in io statements
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
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
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.