From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 17453 invoked by alias); 20 Jul 2010 22:01:30 -0000 Received: (qmail 16937 invoked by uid 22791); 20 Jul 2010 22:01:26 -0000 X-SWARE-Spam-Status: No, hits=-1.0 required=5.0 tests=AWL,BAYES_00,KAM_STOCKGEN,RCVD_IN_DNSWL_NONE,T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from smtp6.netcologne.de (HELO smtp6.netcologne.de) (194.8.194.26) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Tue, 20 Jul 2010 22:01:18 +0000 Received: from [192.168.0.196] (xdsl-213-168-117-96.netcologne.de [213.168.117.96]) by smtp6.netcologne.de (Postfix) with ESMTP id D90BE2A0C0F; Wed, 21 Jul 2010 00:01:14 +0200 (CEST) Subject: Re: [patch, fortran] PR 40628, front-end optimization pass From: Thomas Koenig To: fortran@gcc.gnu.org Cc: gcc-patches@gcc.gnu.org In-Reply-To: References: <1279391905.4628.7.camel@linux-fd1f.site> <4C42BF4D.20400@domob.eu> <4C43D07A.9050500@verizon.net> <1279578709.9185.9.camel@linux-fd1f.site> <4C44F9A4.1080908@verizon.net> <4C4558AF.60309@net-b.de> <4C455DAD.9020509@domob.eu> <4C456FE6.7010805@moene.org> Content-Type: multipart/mixed; boundary="=-LC8S6uXZfyiLHbH4fe9n" Date: Tue, 20 Jul 2010 22:01:00 -0000 Message-ID: <1279663274.29693.4.camel@linux-fd1f.site> Mime-Version: 1.0 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org X-SW-Source: 2010-07/txt/msg01609.txt.bz2 --=-LC8S6uXZfyiLHbH4fe9n Content-Type: text/plain; charset="ISO-8859-1" Content-Transfer-Encoding: 7bit Content-length: 769 Well, here is an updated version of the patch. I have called the new file (mostly unchanged) frontend-passes.c, because my gdb gets confused about having two files called passes.c. I have also changed the place where the gfc_run_passes is called to resolve.c, as pault had suggested on IRC. Regression-tested, only allocate_with_typespec.f90 failed (which I also saw on gcc-testresults). OK? Thomas 2010-07-20 Thomas Koenig * Make-lang.in: Add fortran/frontend-passes.o. * gfortran.h: Add prototype for gfc_run_passes. * resolve.c (gfc_resolve): Call gfc_run_passes. * frontend-passes.c: New file. 2010-0717 Thomas Koenig * trim_optimize_1.f90: New test. * character_comparision_1.f90: New test. --=-LC8S6uXZfyiLHbH4fe9n Content-Disposition: attachment; filename="opt-2.diff" Content-Type: text/x-patch; name="opt-2.diff"; charset="ISO-8859-1" Content-Transfer-Encoding: 7bit Content-length: 1150 Index: Make-lang.in =================================================================== --- Make-lang.in (Revision 162346) +++ Make-lang.in (Arbeitskopie) @@ -66,7 +66,7 @@ fortran/trans.o fortran/trans-array.o fortran/trans-common.o \ fortran/trans-const.o fortran/trans-decl.o fortran/trans-expr.o \ fortran/trans-intrinsic.o fortran/trans-io.o fortran/trans-openmp.o \ - fortran/trans-stmt.o fortran/trans-types.o + fortran/trans-stmt.o fortran/trans-types.o fortran/frontend-passes.o fortran_OBJS = $(F95_OBJS) gfortranspec.o Index: gfortran.h =================================================================== --- gfortran.h (Revision 162346) +++ gfortran.h (Arbeitskopie) @@ -2831,4 +2831,8 @@ #define CLASS_DATA(sym) sym->ts.u.derived->components +/* passes.c */ + +void gfc_run_passes (gfc_namespace *); + #endif /* GCC_GFORTRAN_H */ Index: resolve.c =================================================================== --- resolve.c (Revision 162346) +++ resolve.c (Arbeitskopie) @@ -13068,4 +13068,6 @@ gfc_current_ns = old_ns; cs_base = old_cs_base; ns->resolved = 1; + + gfc_run_passes (ns); } --=-LC8S6uXZfyiLHbH4fe9n Content-Disposition: attachment; filename="trim_optimize_1.f90" Content-Type: text/x-fortran; name="trim_optimize_1.f90"; charset="ISO-8859-1" Content-Transfer-Encoding: 7bit Content-length: 410 ! { dg-do run } ! { dg-options "-O -fdump-tree-original" } ! PR 40628 - optimize unnecessary TRIMs on assignment program main character(len=3) :: a character(len=4) :: b,c b = 'abcd' a = trim(b) c = trim(trim(a)) if (a /= 'abc') call abort if (c /= 'abc') call abort end program main ! { dg-final { scan-tree-dump-times "memmove" 2 "original" } } ! { dg-final { cleanup-tree-dump "original" } } --=-LC8S6uXZfyiLHbH4fe9n Content-Disposition: attachment; filename="character_comparison_1.f90" Content-Type: text/x-fortran; name="character_comparison_1.f90"; charset="ISO-8859-1" Content-Transfer-Encoding: 7bit Content-length: 825 ! { dg-do run } ! { dg-options "-O -fdump-tree-original" } program main implicit none character(len=4) :: c integer :: n integer :: i common /foo/ i n = 0 i = 0 c = 'abcd' n = n + 1 ; if (c == c) call yes n = n + 1 ; if (c >= c) call yes n = n + 1 ; if (c <= c) call yes n = n + 1 ; if (c .eq. c) call yes n = n + 1 ; if (c .ge. c) call yes n = n + 1 ; if (c .le. c) call yes if (c /= c) call abort if (c > c) call abort if (c < c) call abort if (c .ne. c) call abort if (c .gt. c) call abort if (c .lt. c) call abort if (n /= i) call abort end program main subroutine yes implicit none common /foo/ i integer :: i i = i + 1 end subroutine yes ! { dg-final { scan-tree-dump-times "gfortran_compare_string" 0 "original" } } ! { dg-final { cleanup-tree-dump "original" } } --=-LC8S6uXZfyiLHbH4fe9n Content-Disposition: attachment; filename="frontend-passes.c" Content-Type: text/x-csrc; name="frontend-passes.c"; charset="ISO-8859-1" Content-Transfer-Encoding: 8bit Content-length: 9197 /* Pass manager for Fortran front end. Copyright (C) 2010 Free Software Foundation, Inc. Contributed by Thomas König. This file is part of GCC. GCC is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 3, or (at your option) any later version. GCC is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GCC; see the file COPYING3. If not see . */ #include "config.h" #include "system.h" #include "gfortran.h" #include "arith.h" #include "flags.h" /* Forward declarations. */ static void strip_function_call (gfc_expr *); static void optimize_assignment (gfc_code *); static void optimize_expr_0 (gfc_expr *); static bool optimize_expr (gfc_expr *); static bool optimize_op (gfc_expr *); static bool optimize_equality (gfc_expr *, bool); static void optimize_code (gfc_code *); static void optimize_code_node (gfc_code *); static void optimize_actual_arglist (gfc_actual_arglist *); /* Entry point - run all passes for a namespace. So far, only an optimization pass is run. */ void gfc_run_passes (gfc_namespace * ns) { if (optimize) optimize_code (ns->code); } static void optimize_code (gfc_code *c) { for (; c; c = c->next) optimize_code_node (c); } /* Do the optimizations for a code node. */ static void optimize_code_node (gfc_code *c) { gfc_forall_iterator *fa; gfc_code *d; gfc_alloc *a; switch (c->op) { case EXEC_ASSIGN: optimize_assignment (c); break; case EXEC_CALL: case EXEC_ASSIGN_CALL: case EXEC_CALL_PPC: optimize_actual_arglist (c->ext.actual); break; case EXEC_ARITHMETIC_IF: optimize_expr_0 (c->expr1); break; case EXEC_PAUSE: case EXEC_RETURN: case EXEC_ERROR_STOP: case EXEC_STOP: case EXEC_COMPCALL: optimize_expr_0 (c->expr1); break; case EXEC_SYNC_ALL: case EXEC_SYNC_MEMORY: case EXEC_SYNC_IMAGES: optimize_expr_0 (c->expr2); break; case EXEC_IF: d = c->block; optimize_expr_0 (d->expr1); optimize_code (d->next); for (d = d->block; d; d = d->block) { optimize_expr_0 (d->expr1); optimize_code (d->next); } break; case EXEC_SELECT: case EXEC_SELECT_TYPE: d = c->block; optimize_expr_0 (c->expr1); for (; d; d = d->block) optimize_code (d->next); break; case EXEC_WHERE: d = c->block; optimize_expr_0 (d->expr1); optimize_code (d->next); for (d = d->block; d; d = d->block) { optimize_expr_0 (d->expr1); optimize_code (d->next); } break; case EXEC_FORALL: for (fa = c->ext.forall_iterator; fa; fa = fa->next) { optimize_expr_0 (fa->start); optimize_expr_0 (fa->end); optimize_expr_0 (fa->stride); } if (c->expr1 != NULL) optimize_expr_0 (c->expr1); optimize_code (c->block->next); break; case EXEC_CRITICAL: optimize_code (c->block->next); break; case EXEC_DO: optimize_expr_0 (c->ext.iterator->start); optimize_expr_0 (c->ext.iterator->end); optimize_expr_0 (c->ext.iterator->step); optimize_code (c->block->next); break; case EXEC_DO_WHILE: optimize_expr_0 (c->expr1); optimize_code (c->block->next); break; case EXEC_ALLOCATE: for (a = c->ext.alloc.list; a; a = a->next) optimize_expr_0 (a->expr); break; /* Todo: Some of these may need to be optimized, as well. */ case EXEC_WRITE: case EXEC_READ: case EXEC_OPEN: case EXEC_INQUIRE: case EXEC_REWIND: case EXEC_ENDFILE: case EXEC_BACKSPACE: case EXEC_CLOSE: case EXEC_WAIT: case EXEC_TRANSFER: case EXEC_FLUSH: case EXEC_IOLENGTH: case EXEC_END_PROCEDURE: case EXEC_NOP: case EXEC_CONTINUE: case EXEC_ENTRY: case EXEC_INIT_ASSIGN: case EXEC_LABEL_ASSIGN: case EXEC_POINTER_ASSIGN: case EXEC_GOTO: case EXEC_CYCLE: case EXEC_EXIT: case EXEC_BLOCK: case EXEC_END_BLOCK: case EXEC_OMP_ATOMIC: case EXEC_OMP_BARRIER: case EXEC_OMP_CRITICAL: case EXEC_OMP_FLUSH: case EXEC_OMP_DO: case EXEC_OMP_MASTER: case EXEC_OMP_ORDERED: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_SECTIONS: case EXEC_OMP_SINGLE: case EXEC_OMP_TASK: case EXEC_OMP_TASKWAIT: case EXEC_OMP_WORKSHARE: case EXEC_DEALLOCATE: break; default: gcc_unreachable (); } } /* Optimizations for an assignment. */ static void optimize_assignment (gfc_code * c) { gfc_expr *lhs, *rhs; lhs = c->expr1; rhs = c->expr2; /* Optimize away a = trim(b), where a is a character variable. */ if (lhs->ts.type == BT_CHARACTER) { if (rhs->expr_type == EXPR_FUNCTION && rhs->value.function.isym && rhs->value.function.isym->id == GFC_ISYM_TRIM) { strip_function_call (rhs); optimize_assignment (c); return; } } /* All direct optimizations have been done. Now it's time to optimize the rhs. */ optimize_expr_0 (rhs); } /* Remove an unneeded function call, modifying the expression. This replaces the function call with the value of its first argument. The rest of the argument list is freed. */ static void strip_function_call (gfc_expr *e) { gfc_expr *e1; gfc_actual_arglist *a; a = e->value.function.actual; /* We should have at least one argument. */ gcc_assert (a->expr != NULL); e1 = a->expr; /* Free the remaining arglist, if any. */ if (a->next) gfc_free_actual_arglist (a->next); /* Graft the argument expression onto the original function. */ *e = *e1; gfc_free (e1); } /* Top-level optimization of expressions. Calls gfc_simplify_expr if optimize_expr succeeds in doing something. TODO: Optimization of multiple function occurrence to come here. */ static void optimize_expr_0 (gfc_expr * e) { if (optimize_expr (e)) gfc_simplify_expr (e, 0); return; } /* Recursive optimization of expressions. TODO: Make this handle many more things. */ static bool optimize_expr (gfc_expr *e) { bool ret; if (e == NULL) return false; ret = false; switch (e->expr_type) { case EXPR_OP: return optimize_op (e); break; case EXPR_FUNCTION: optimize_actual_arglist (e->value.function.actual); break; default: break; } return ret; } /* Recursive optimization of operators. */ static bool optimize_op (gfc_expr *e) { gfc_intrinsic_op op; op = e->value.op.op; switch (op) { case INTRINSIC_EQ: case INTRINSIC_EQ_OS: case INTRINSIC_GE: case INTRINSIC_GE_OS: case INTRINSIC_LE: case INTRINSIC_LE_OS: return optimize_equality (e, true); break; case INTRINSIC_NE: case INTRINSIC_NE_OS: case INTRINSIC_GT: case INTRINSIC_GT_OS: case INTRINSIC_LT: case INTRINSIC_LT_OS: return optimize_equality (e, false); break; default: break; } return false; } /* Optimize expressions for equality. */ static bool optimize_equality (gfc_expr *e, bool equal) { gfc_expr *op1, *op2; bool change; op1 = e->value.op.op1; op2 = e->value.op.op2; /* Strip off unneeded TRIM calls from string comparisons. */ change = false; if (op1->expr_type == EXPR_FUNCTION && op1->value.function.isym && op1->value.function.isym->id == GFC_ISYM_TRIM) { strip_function_call (op1); change = true; } if (op2->expr_type == EXPR_FUNCTION && op2->value.function.isym && op2->value.function.isym->id == GFC_ISYM_TRIM) { strip_function_call (op2); change = true; } if (change) { optimize_equality (e, equal); return true; } /* Check for direct comparison between identical variables. TODO: Handle cases with identical refs. */ if (op1->expr_type == EXPR_VARIABLE && op2->expr_type == EXPR_VARIABLE && op1->symtree == op2->symtree && op1->ref == NULL && op2->ref == NULL && op1->ts.type != BT_REAL && op2->ts.type != BT_REAL && op1->ts.type != BT_COMPLEX && op2->ts.type !=BT_COMPLEX) { /* Replace the expression by a constant expression. The typespec and where remains the way it is. */ gfc_free (op1); gfc_free (op2); e->expr_type = EXPR_CONSTANT; e->value.logical = equal; return true; } return false; } /* Optimize a call list. Right now, this just goes through the actual arg list and optimizes each expression in turn. */ static void optimize_actual_arglist (gfc_actual_arglist *a) { for (; a; a = a->next) { if (a->expr != NULL) optimize_expr_0 (a->expr); } return; } --=-LC8S6uXZfyiLHbH4fe9n--