From: Nicolas Koenig <koenigni@student.ethz.ch>
To: "Dominique d'Humières" <dominiq@lps.ens.fr>
Cc: Bernhard Reutner-Fischer <rep.dot.nop@gmail.com>,
gfortran <fortran@gcc.gnu.org>,
gcc-patches <gcc-patches@gcc.gnu.org>
Subject: Re: [Patch, fortran] PR35339 Optimize implied do loops in io statements
Date: Sat, 03 Jun 2017 13:48:00 -0000 [thread overview]
Message-ID: <ce3115b3-0123-2fc6-a390-ee3318e35e60@student.ethz.ch> (raw)
In-Reply-To: <2E75B017-9A43-4734-BF38-8FA7A69962B8@lps.ens.fr>
[-- Attachment #1: Type: text/plain, Size: 738 bytes --]
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 <koenigni@student.ethz.ch>
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 <koenigni@student.ethz.ch>
PR fortran/35339
* gfortran.dg/implied_do_io_1.f90: New Test.
* gfortran.dg/implied_do_io_2.f90: New Test.
[-- Attachment #2: p9.diff --]
[-- Type: text/x-patch, Size: 9861 bytes --]
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 strides if necessary. */
+ for (i = 0; i < ref->u.ar.dimen; i++)
+ {
+ if (!iters[i])
+ continue;
+ start = ref->u.ar.start[i];
+ switch (start->expr_type)
+ {
+ case EXPR_CONSTANT:
+ gfc_internal_error("bad expression");
+ break;
+ case EXPR_VARIABLE:
+ new_e->ref->u.ar.dimen_type[i] = DIMEN_RANGE;
+ new_e->ref->u.ar.type = AR_SECTION;
+ gfc_free_expr(new_e->ref->u.ar.start[i]);
+ new_e->ref->u.ar.start[i] = gfc_copy_expr(iters[i]->start);
+ new_e->ref->u.ar.end[i] = gfc_copy_expr(iters[i]->end);
+ new_e->ref->u.ar.stride[i] = gfc_copy_expr(iters[i]->step);
+ break;
+ case EXPR_OP:
+ new_e->ref->u.ar.dimen_type[i] = DIMEN_RANGE;
+ new_e->ref->u.ar.type = AR_SECTION;
+ gfc_free_expr(new_e->ref->u.ar.start[i]);
+ expr = gfc_copy_expr(start);
+ expr->value.op.op1 = gfc_copy_expr(iters[i]->start);
+ new_e->ref->u.ar.start[i] = expr;
+ gfc_simplify_expr(new_e->ref->u.ar.start[i], 0);
+ expr = gfc_copy_expr(start);
+ expr->value.op.op1 = gfc_copy_expr(iters[i]->end);
+ new_e->ref->u.ar.end[i] = expr;
+ gfc_simplify_expr(new_e->ref->u.ar.end[i], 0);
+ switch(start->value.op.op)
+ {
+ case INTRINSIC_MINUS:
+ case INTRINSIC_PLUS:
+ new_e->ref->u.ar.stride[i] = gfc_copy_expr(iters[i]->step);
+ break;
+ case INTRINSIC_TIMES:
+ expr = gfc_copy_expr(start);
+ expr->value.op.op1 = gfc_copy_expr(iters[i]->step);
+ new_e->ref->u.ar.stride[i] = expr;
+ gfc_simplify_expr(new_e->ref->u.ar.stride[i], 0);
+ break;
+ default:
+ gfc_internal_error("bad op");
+ }
+ break;
+ default:
+ gfc_internal_error("bad expression");
+ }
+ }
+ curr->expr1 = new_e;
+
+ /* Insert modified statement. Check whether the statement needs to be
+ inserted at the lowest level. */
+ if (!stack_top->iter)
+ {
+ if (prev)
+ {
+ curr->next = prev->next->next;
+ prev->next = curr;
+ }
+ else
+ {
+ curr->next = stack_top->code->block->next->next->next;
+ stack_top->code->block->next = curr;
+ }
+ }
+ else
+ stack_top->code->block->next = curr;
+ return true;
+}
+
+/* Function for the gfc_code_walker. If code is a READ or WRITE statement, it
+ tries to optimize its block. */
+
+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;
+ traverse_io_block((*curr)->block->next, &b, prev);
+ stack_top = NULL;
+ }
+ prev = *curr;
+ }
+ return 0;
+}
+
/* Optimize a namespace, including all contained namespaces. */
static void
@@ -1077,6 +1334,7 @@ optimize_namespace (gfc_namespace *ns)
in_assoc_list = false;
in_omp_workshare = false;
+ gfc_code_walker (&ns->code, simplify_io_impl_do, dummy_expr_callback, NULL);
gfc_code_walker (&ns->code, convert_do_while, dummy_expr_callback, NULL);
gfc_code_walker (&ns->code, convert_elseif, dummy_expr_callback, NULL);
gfc_code_walker (&ns->code, cfe_code, cfe_expr_0, NULL);
Index: gfc-internals.texi
===================================================================
--- gfc-internals.texi (Revision 248467)
+++ gfc-internals.texi (Arbeitskopie)
@@ -115,6 +115,7 @@ not accurately reflect the status of the most rece
@comment
@menu
* Introduction:: About this manual.
+* Main structure:: Main structure of the compiler
* User Interface:: Code that Interacts with the User.
* Frontend Data Structures::
Data structures used by the frontend
@@ -153,7 +154,43 @@ guide; in the interim, GNU Fortran developers are
contribute to it as a way of keeping notes while working on the
compiler.
+@c ---------------------------------------------------------------------
+@c Main structure of the compiler
+@c ---------------------------------------------------------------------
+@node Main structure
+@chapter Main structure of the compiler
+
+Operation of the compiler can be structured into the main phases
+initialization, parsing, resolution, front-end passes and translations.
+
+The main entry point of the Fortran compiler is
+@code{gfc_be_parse_file} in @file{f95-lang.c}.
+
+@menu
+* Initialization:: Initializing the internal data stuctures.
+* Parsing:: Parsing the user's input.
+* Resolution:: Completing information in the syntax tree.
+* Front-end passes:: Manipulating the syntax tree
+* Translation:: Translating the syntax tree to the middle-end representation
+@end menu
+
+@node Initialization
+@section Initialization
+
+@node Parsing
+@section Parsing
+
+The main entry for parsing is
+@node Resolution
+@section Resolution
+
+@node Front-end passes
+@section Front-end passes
+
+@node Translation
+@section Translation
+
@c ---------------------------------------------------------------------
@c Code that Interacts with the User
@c ---------------------------------------------------------------------
[-- Attachment #3: implied_do_io_1.f90 --]
[-- Type: text/x-fortran, Size: 1743 bytes --]
! { dg-do run }
! { dg-options "-O -fdump-tree-original" }
! PR/35339
! This test ensures optimization of implied do loops in io statements
program main
implicit none
integer:: i, j, square
integer, parameter:: k = 2, linenum = 14
integer, dimension(2):: a = [(i, i=1,2)]
integer, dimension(2,2):: b = reshape([1, 2, 3, 4], shape(b))
character (len=30), dimension(linenum) :: res
character (len=30) :: line
type tp
integer, dimension(2):: i
end type
type(tp), dimension(2):: t = [tp([1, 2]), tp([1, 2])]
data res / &
' a 2 2', &
' b 1 2', &
' c 1 2', &
' d 1 2', &
' e 1 2 1 2', &
' f 1 2 1 1 2 2', &
' g 1 2 3 4', &
' h 1 3 2 4', &
' i 2', &
' j 2', &
' k 1 2 1 2', &
' l 1', &
' m 1 1', &
' n 1 2'/
open(10,file="test.dat")
write (10,1000) 'a', (a(k), i=1,2)
write (10,1000) 'b', (b(i, 1), i=1,2)
write (10,1000) 'c', b(1:2:1, 1)
write (10,1000) 'd', (a(i), i=1,2)
write (10,1000) 'e', ((a(i), i=1,2), j=1,2)
write (10,1000) 'f', (a, b(i, 1), i = 1,2)
write (10,1000) 'g', ((b(i, j), i=1,2),j=1,2)
write (10,1000) 'h', ((b(j, i), i=1,2),j=1,2)
write (10,1000) 'i', (a(i+1), i=1,1)
write (10,1000) 'j', (a(i*2), i=1,1)
write (10,1000) 'k', (a(i), i=1,2), (a(i), i=1,2)
write (10,1000) 'l', (a(i), i=1,1)
write (10,1000) 'm', (1, i=1,2)
write (10,1000) 'n', (t(i)%i(i), i=1,2)
rewind (10)
do i=1,linenum
read (10,'(A)') line
if (line .ne. res(i)) call abort
end do
close(10,status="delete")
1000 format (A2,100I4)
end program main
! { dg-final { scan-tree-dump-times "while" 7 "original" } }
[-- Attachment #4: implied_do_io_2.f90 --]
[-- Type: text/x-fortran, Size: 615 bytes --]
! { dg-do run }
! Test that allocatable characters with deferred length
! are written correctly
program main
implicit none
integer:: i
integer, parameter:: N = 10
character(len=:), dimension(:),allocatable:: ca
character(len=50):: buffer, line
allocate(character(len=N):: ca(3))
buffer = "foo bar xyzzy"
ca(1) = "foo"
ca(2) = "bar"
ca(3) = "xyzzy"
write (unit=line, fmt='(3A5)') (ca(i),i=1,3)
if (line /= buffer) call abort
ca(1) = ""
ca(2) = ""
ca(3) = ""
read (unit=line, fmt='(3A5)') (ca(i),i=1,3)
if (line /= buffer) call abort
end program
next prev parent reply other threads:[~2017-06-03 13:48 UTC|newest]
Thread overview: 24+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-05-29 15:49 Dominique d'Humières
2017-05-29 16:24 ` Nicolas Koenig
2017-05-29 16:51 ` Dominique d'Humières
2017-05-31 15:40 ` Bernhard Reutner-Fischer
2017-05-31 15:49 ` Dominique d'Humières
2017-05-31 19:03 ` Dominique d'Humières
2017-05-31 23:15 ` Nicolas Koenig
2017-06-01 9:31 ` Dominique d'Humières
2017-06-01 14:19 ` Dominique d'Humières
2017-06-01 14:37 ` Dominique d'Humières
2017-06-01 18:26 ` Nicolas Koenig
2017-06-03 13:48 ` Nicolas Koenig [this message]
2017-06-03 16:25 ` Jerry DeLisle
2017-06-03 18:12 ` Bernhard Reutner-Fischer
2017-06-05 20:39 ` Nicolas Koenig
2017-06-06 11:05 ` Markus Trippelsdorf
2017-06-07 15:13 ` Renlin Li
2017-11-02 8:25 ` [testsuite, committed] Fix scan pattern in gfortran.dg/implied_do_io_1.f90 Tom de Vries
-- strict thread matches above, loose matches on Subject: below --
2017-05-27 19:49 [Patch, fortran] PR35339 Optimize implied do loops in io statements Nicolas Koenig
2017-05-28 22:07 ` Jerry DeLisle
2017-05-28 23:32 ` Nicolas Koenig
2017-05-29 6:40 ` Thomas Koenig
2017-05-29 14:06 ` Thomas Koenig
2017-05-29 15:32 ` Jerry DeLisle
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=ce3115b3-0123-2fc6-a390-ee3318e35e60@student.ethz.ch \
--to=koenigni@student.ethz.ch \
--cc=dominiq@lps.ens.fr \
--cc=fortran@gcc.gnu.org \
--cc=gcc-patches@gcc.gnu.org \
--cc=rep.dot.nop@gmail.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).