1 /* Pass manager for Fortran front end.
2 Copyright (C) 2010 Free Software Foundation, Inc.
3 Contributed by Thomas König.
5 This file is part of GCC.
7 GCC is free software; you can redistribute it and/or modify it under
8 the terms of the GNU General Public License as published by the Free
9 Software Foundation; either version 3, or (at your option) any later
12 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
13 WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 You should have received a copy of the GNU General Public License
18 along with GCC; see the file COPYING3. If not see
19 <http://www.gnu.org/licenses/>. */
27 /* Forward declarations. */
29 static void strip_function_call (gfc_expr *);
30 static void optimize_assignment (gfc_code *);
31 static void optimize_expr_0 (gfc_expr *);
32 static bool optimize_expr (gfc_expr *);
33 static bool optimize_op (gfc_expr *);
34 static bool optimize_equality (gfc_expr *, bool);
35 static void optimize_code (gfc_code *);
36 static void optimize_code_node (gfc_code *);
37 static void optimize_actual_arglist (gfc_actual_arglist *);
39 /* Entry point - run all passes for a namespace. So far, only an
40 optimization pass is run. */
43 gfc_run_passes (gfc_namespace * ns)
46 optimize_code (ns->code);
50 optimize_code (gfc_code *c)
52 for (; c; c = c->next)
53 optimize_code_node (c);
57 /* Do the optimizations for a code node. */
60 optimize_code_node (gfc_code *c)
63 gfc_forall_iterator *fa;
70 optimize_assignment (c);
74 case EXEC_ASSIGN_CALL:
76 optimize_actual_arglist (c->ext.actual);
79 case EXEC_ARITHMETIC_IF:
80 optimize_expr_0 (c->expr1);
88 optimize_expr_0 (c->expr1);
92 case EXEC_SYNC_MEMORY:
93 case EXEC_SYNC_IMAGES:
94 optimize_expr_0 (c->expr2);
99 optimize_expr_0 (d->expr1);
100 optimize_code (d->next);
102 for (d = d->block; d; d = d->block)
104 optimize_expr_0 (d->expr1);
106 optimize_code (d->next);
113 case EXEC_SELECT_TYPE:
116 optimize_expr_0 (c->expr1);
118 for (; d; d = d->block)
119 optimize_code (d->next);
125 optimize_expr_0 (d->expr1);
126 optimize_code (d->next);
128 for (d = d->block; d; d = d->block)
130 optimize_expr_0 (d->expr1);
131 optimize_code (d->next);
137 for (fa = c->ext.forall_iterator; fa; fa = fa->next)
139 optimize_expr_0 (fa->start);
140 optimize_expr_0 (fa->end);
141 optimize_expr_0 (fa->stride);
144 if (c->expr1 != NULL)
145 optimize_expr_0 (c->expr1);
147 optimize_code (c->block->next);
152 optimize_code (c->block->next);
156 optimize_expr_0 (c->ext.iterator->start);
157 optimize_expr_0 (c->ext.iterator->end);
158 optimize_expr_0 (c->ext.iterator->step);
159 optimize_code (c->block->next);
164 optimize_expr_0 (c->expr1);
165 optimize_code (c->block->next);
170 for (a = c->ext.alloc.list; a; a = a->next)
171 optimize_expr_0 (a->expr);
174 /* Todo: Some of these may need to be optimized, as well. */
187 case EXEC_END_PROCEDURE:
191 case EXEC_INIT_ASSIGN:
192 case EXEC_LABEL_ASSIGN:
193 case EXEC_POINTER_ASSIGN:
199 case EXEC_OMP_ATOMIC:
200 case EXEC_OMP_BARRIER:
201 case EXEC_OMP_CRITICAL:
204 case EXEC_OMP_MASTER:
205 case EXEC_OMP_ORDERED:
206 case EXEC_OMP_PARALLEL:
207 case EXEC_OMP_PARALLEL_DO:
208 case EXEC_OMP_PARALLEL_SECTIONS:
209 case EXEC_OMP_PARALLEL_WORKSHARE:
210 case EXEC_OMP_SECTIONS:
211 case EXEC_OMP_SINGLE:
213 case EXEC_OMP_TASKWAIT:
214 case EXEC_OMP_WORKSHARE:
215 case EXEC_DEALLOCATE:
225 /* Optimizations for an assignment. */
228 optimize_assignment (gfc_code * c)
235 /* Optimize away a = trim(b), where a is a character variable. */
237 if (lhs->ts.type == BT_CHARACTER)
239 if (rhs->expr_type == EXPR_FUNCTION &&
240 rhs->value.function.isym &&
241 rhs->value.function.isym->id == GFC_ISYM_TRIM)
243 strip_function_call (rhs);
244 optimize_assignment (c);
249 /* All direct optimizations have been done. Now it's time
250 to optimize the rhs. */
252 optimize_expr_0 (rhs);
256 /* Remove an unneeded function call, modifying the expression.
257 This replaces the function call with the value of its
258 first argument. The rest of the argument list is freed. */
261 strip_function_call (gfc_expr *e)
264 gfc_actual_arglist *a;
266 a = e->value.function.actual;
268 /* We should have at least one argument. */
269 gcc_assert (a->expr != NULL);
273 /* Free the remaining arglist, if any. */
275 gfc_free_actual_arglist (a->next);
277 /* Graft the argument expression onto the original function. */
283 /* Top-level optimization of expressions. Calls gfc_simplify_expr if
284 optimize_expr succeeds in doing something.
285 TODO: Optimization of multiple function occurrence to come here. */
288 optimize_expr_0 (gfc_expr * e)
290 if (optimize_expr (e))
291 gfc_simplify_expr (e, 0);
296 /* Recursive optimization of expressions.
297 TODO: Make this handle many more things. */
300 optimize_expr (gfc_expr *e)
309 switch (e->expr_type)
312 return optimize_op (e);
316 optimize_actual_arglist (e->value.function.actual);
326 /* Recursive optimization of operators. */
329 optimize_op (gfc_expr *e)
339 case INTRINSIC_EQ_OS:
341 case INTRINSIC_GE_OS:
343 case INTRINSIC_LE_OS:
344 return optimize_equality (e, true);
348 case INTRINSIC_NE_OS:
350 case INTRINSIC_GT_OS:
352 case INTRINSIC_LT_OS:
353 return optimize_equality (e, false);
363 /* Optimize expressions for equality. */
366 optimize_equality (gfc_expr *e, bool equal)
372 op1 = e->value.op.op1;
373 op2 = e->value.op.op2;
375 /* Strip off unneeded TRIM calls from string comparisons. */
379 if (op1->expr_type == EXPR_FUNCTION
380 && op1->value.function.isym
381 && op1->value.function.isym->id == GFC_ISYM_TRIM)
383 strip_function_call (op1);
387 if (op2->expr_type == EXPR_FUNCTION
388 && op2->value.function.isym
389 && op2->value.function.isym->id == GFC_ISYM_TRIM)
391 strip_function_call (op2);
397 optimize_equality (e, equal);
401 /* Check for direct comparison between identical variables.
402 TODO: Handle cases with identical refs. */
403 if (op1->expr_type == EXPR_VARIABLE
404 && op2->expr_type == EXPR_VARIABLE
405 && op1->symtree == op2->symtree
406 && op1->ref == NULL && op2->ref == NULL
407 && op1->ts.type != BT_REAL && op2->ts.type != BT_REAL
408 && op1->ts.type != BT_COMPLEX && op2->ts.type !=BT_COMPLEX)
410 /* Replace the expression by a constant expression. The typespec
411 and where remains the way it is. */
414 e->expr_type = EXPR_CONSTANT;
415 e->value.logical = equal;
421 /* Optimize a call list. Right now, this just goes through the actual
422 arg list and optimizes each expression in turn. */
425 optimize_actual_arglist (gfc_actual_arglist *a)
428 for (; a; a = a->next)
431 optimize_expr_0 (a->expr);