OSDN Git Service

0777dba6869c16448e52b6a1fb3280bf9f6e89db
[pf3gnuchains/gcc-fork.git] / gcc / fortran / frontend-passes.c
1 /* Pass manager for Fortran front end.
2    Copyright (C) 2010 Free Software Foundation, Inc.
3    Contributed by Thomas K├Ânig.
4
5 This file is part of GCC.
6
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
10 version.
11
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
15 for more details.
16
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/>.  */
20
21 #include "config.h"
22 #include "system.h"
23 #include "gfortran.h"
24 #include "arith.h"
25 #include "flags.h"
26 #include "dependency.h"
27 #include "constructor.h"
28 #include "opts.h"
29
30 /* Forward declarations.  */
31
32 static void strip_function_call (gfc_expr *);
33 static void optimize_namespace (gfc_namespace *);
34 static void optimize_assignment (gfc_code *);
35 static bool optimize_op (gfc_expr *);
36 static bool optimize_comparison (gfc_expr *, gfc_intrinsic_op);
37 static bool optimize_trim (gfc_expr *);
38
39 /* How deep we are inside an argument list.  */
40
41 static int count_arglist;
42
43 /* Entry point - run all passes for a namespace.  So far, only an
44    optimization pass is run.  */
45
46 void
47 gfc_run_passes (gfc_namespace *ns)
48 {
49   if (optimize)
50     {
51       optimize_namespace (ns);
52       if (gfc_option.dump_fortran_optimized)
53         gfc_dump_parse_tree (ns, stdout);
54     }
55 }
56
57 /* Callback for each gfc_code node invoked through gfc_code_walker
58    from optimize_namespace.  */
59
60 static int
61 optimize_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
62                void *data ATTRIBUTE_UNUSED)
63 {
64
65   gfc_exec_op op;
66
67   op = (*c)->op;
68
69   if (op == EXEC_CALL || op == EXEC_COMPCALL || op == EXEC_ASSIGN_CALL
70       || op == EXEC_CALL_PPC)
71     count_arglist = 1;
72   else
73     count_arglist = 0;
74
75   if (op == EXEC_ASSIGN)
76     optimize_assignment (*c);
77   return 0;
78 }
79
80 /* Callback for each gfc_expr node invoked through gfc_code_walker
81    from optimize_namespace.  */
82
83 static int
84 optimize_expr (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
85                void *data ATTRIBUTE_UNUSED)
86 {
87   bool function_expr;
88
89   if ((*e)->expr_type == EXPR_FUNCTION)
90     {
91       count_arglist ++;
92       function_expr = true;
93     }
94   else
95     function_expr = false;
96
97   if (optimize_trim (*e))
98     gfc_simplify_expr (*e, 0);
99
100   if ((*e)->expr_type == EXPR_OP && optimize_op (*e))
101     gfc_simplify_expr (*e, 0);
102
103   if (function_expr)
104     count_arglist --;
105
106   return 0;
107 }
108
109 /* Optimize a namespace, including all contained namespaces.  */
110
111 static void
112 optimize_namespace (gfc_namespace *ns)
113 {
114   gfc_code_walker (&ns->code, optimize_code, optimize_expr, NULL);
115
116   for (ns = ns->contained; ns; ns = ns->sibling)
117     optimize_namespace (ns);
118 }
119
120 /* Replace code like
121    a = matmul(b,c) + d
122    with
123    a = matmul(b,c) ;   a = a + d
124    where the array function is not elemental and not allocatable
125    and does not depend on the left-hand side.
126 */
127
128 static bool
129 optimize_binop_array_assignment (gfc_code *c, gfc_expr **rhs, bool seen_op)
130 {
131   gfc_expr *e;
132
133   e = *rhs;
134   if (e->expr_type == EXPR_OP)
135     {
136       switch (e->value.op.op)
137         {
138           /* Unary operators and exponentiation: Only look at a single
139              operand.  */
140         case INTRINSIC_NOT:
141         case INTRINSIC_UPLUS:
142         case INTRINSIC_UMINUS:
143         case INTRINSIC_PARENTHESES:
144         case INTRINSIC_POWER:
145           if (optimize_binop_array_assignment (c, &e->value.op.op1, seen_op))
146             return true;
147           break;
148
149         default:
150           /* Binary operators.  */
151           if (optimize_binop_array_assignment (c, &e->value.op.op1, true))
152             return true;
153
154           if (optimize_binop_array_assignment (c, &e->value.op.op2, true))
155             return true;
156
157           break;
158         }
159     }
160   else if (seen_op && e->expr_type == EXPR_FUNCTION && e->rank > 0
161            && ! (e->value.function.esym 
162                  && (e->value.function.esym->attr.elemental 
163                      || e->value.function.esym->attr.allocatable
164                      || e->value.function.esym->ts.type != c->expr1->ts.type
165                      || e->value.function.esym->ts.kind != c->expr1->ts.kind))
166            && ! (e->value.function.isym
167                  && (e->value.function.isym->elemental
168                      || e->ts.type != c->expr1->ts.type
169                      || e->ts.kind != c->expr1->ts.kind)))
170     {
171
172       gfc_code *n;
173       gfc_expr *new_expr;
174
175       /* Insert a new assignment statement after the current one.  */
176       n = XCNEW (gfc_code);
177       n->op = EXEC_ASSIGN;
178       n->loc = c->loc;
179       n->next = c->next;
180       c->next = n;
181
182       n->expr1 = gfc_copy_expr (c->expr1);
183       n->expr2 = c->expr2;
184       new_expr = gfc_copy_expr (c->expr1);
185       c->expr2 = e;
186       *rhs = new_expr;
187       
188       return true;
189
190     }
191
192   /* Nothing to optimize.  */
193   return false;
194 }
195
196 /* Optimizations for an assignment.  */
197
198 static void
199 optimize_assignment (gfc_code * c)
200 {
201   gfc_expr *lhs, *rhs;
202
203   lhs = c->expr1;
204   rhs = c->expr2;
205
206   /* Optimize away a = trim(b), where a is a character variable.  */
207
208   if (lhs->ts.type == BT_CHARACTER)
209     {
210       if (rhs->expr_type == EXPR_FUNCTION &&
211           rhs->value.function.isym &&
212           rhs->value.function.isym->id == GFC_ISYM_TRIM)
213         {
214           strip_function_call (rhs);
215           optimize_assignment (c);
216           return;
217         }
218     }
219
220   if (lhs->rank > 0 && gfc_check_dependency (lhs, rhs, true) == 0)
221     optimize_binop_array_assignment (c, &rhs, false);
222 }
223
224
225 /* Remove an unneeded function call, modifying the expression.
226    This replaces the function call with the value of its
227    first argument.  The rest of the argument list is freed.  */
228
229 static void
230 strip_function_call (gfc_expr *e)
231 {
232   gfc_expr *e1;
233   gfc_actual_arglist *a;
234
235   a = e->value.function.actual;
236
237   /* We should have at least one argument.  */
238   gcc_assert (a->expr != NULL);
239
240   e1 = a->expr;
241
242   /* Free the remaining arglist, if any.  */
243   if (a->next)
244     gfc_free_actual_arglist (a->next);
245
246   /* Graft the argument expression onto the original function.  */
247   *e = *e1;
248   gfc_free (e1);
249
250 }
251
252 /* Recursive optimization of operators.  */
253
254 static bool
255 optimize_op (gfc_expr *e)
256 {
257   gfc_intrinsic_op op = e->value.op.op;
258
259   switch (op)
260     {
261     case INTRINSIC_EQ:
262     case INTRINSIC_EQ_OS:
263     case INTRINSIC_GE:
264     case INTRINSIC_GE_OS:
265     case INTRINSIC_LE:
266     case INTRINSIC_LE_OS:
267     case INTRINSIC_NE:
268     case INTRINSIC_NE_OS:
269     case INTRINSIC_GT:
270     case INTRINSIC_GT_OS:
271     case INTRINSIC_LT:
272     case INTRINSIC_LT_OS:
273       return optimize_comparison (e, op);
274
275     default:
276       break;
277     }
278
279   return false;
280 }
281
282 /* Optimize expressions for equality.  */
283
284 static bool
285 optimize_comparison (gfc_expr *e, gfc_intrinsic_op op)
286 {
287   gfc_expr *op1, *op2;
288   bool change;
289   int eq;
290   bool result;
291
292   op1 = e->value.op.op1;
293   op2 = e->value.op.op2;
294
295   /* Strip off unneeded TRIM calls from string comparisons.  */
296
297   change = false;
298
299   if (op1->expr_type == EXPR_FUNCTION 
300       && op1->value.function.isym
301       && op1->value.function.isym->id == GFC_ISYM_TRIM)
302     {
303       strip_function_call (op1);
304       change = true;
305     }
306
307   if (op2->expr_type == EXPR_FUNCTION 
308       && op2->value.function.isym
309       && op2->value.function.isym->id == GFC_ISYM_TRIM)
310     {
311       strip_function_call (op2);
312       change = true;
313     }
314
315   if (change)
316     {
317       optimize_comparison (e, op);
318       return true;
319     }
320
321   /* An expression of type EXPR_CONSTANT is only valid for scalars.  */
322   /* TODO: A scalar constant may be acceptable in some cases (the scalarizer
323      handles them well). However, there are also cases that need a non-scalar
324      argument. For example the any intrinsic. See PR 45380.  */
325   if (e->rank > 0)
326     return false;
327
328   /* Don't compare REAL or COMPLEX expressions when honoring NaNs.  */
329
330   if (flag_finite_math_only
331       || (op1->ts.type != BT_REAL && op2->ts.type != BT_REAL
332           && op1->ts.type != BT_COMPLEX && op2->ts.type != BT_COMPLEX))
333     {
334       eq = gfc_dep_compare_expr (op1, op2);
335       if (eq == -2)
336         {
337           /* Replace A // B < A // C with B < C, and A // B < C // B
338              with A < C.  */
339           if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER
340               && op1->value.op.op == INTRINSIC_CONCAT
341               && op2->value.op.op == INTRINSIC_CONCAT)
342             {
343               gfc_expr *op1_left = op1->value.op.op1;
344               gfc_expr *op2_left = op2->value.op.op1;
345               gfc_expr *op1_right = op1->value.op.op2;
346               gfc_expr *op2_right = op2->value.op.op2;
347
348               if (gfc_dep_compare_expr (op1_left, op2_left) == 0)
349                 {
350                   /* Watch out for 'A ' // x vs. 'A' // x.  */
351
352                   if (op1_left->expr_type == EXPR_CONSTANT
353                         && op2_left->expr_type == EXPR_CONSTANT
354                         && op1_left->value.character.length
355                            != op2_left->value.character.length)
356                     return -2;
357                   else
358                     {
359                       gfc_free (op1_left);
360                       gfc_free (op2_left);
361                       e->value.op.op1 = op1_right;
362                       e->value.op.op2 = op2_right;
363                       optimize_comparison (e, op);
364                       return true;
365                     }
366                 }
367               if (gfc_dep_compare_expr (op1_right, op2_right) == 0)
368                 {
369                   gfc_free (op1_right);
370                   gfc_free (op2_right);
371                   e->value.op.op1 = op1_left;
372                   e->value.op.op2 = op2_left;
373                   optimize_comparison (e, op);
374                   return true;
375                 }
376             }
377         }
378       else
379         {
380           /* eq can only be -1, 0 or 1 at this point.  */
381           switch (op)
382             {
383             case INTRINSIC_EQ:
384             case INTRINSIC_EQ_OS:
385               result = eq == 0;
386               break;
387               
388             case INTRINSIC_GE:
389             case INTRINSIC_GE_OS:
390               result = eq >= 0;
391               break;
392
393             case INTRINSIC_LE:
394             case INTRINSIC_LE_OS:
395               result = eq <= 0;
396               break;
397
398             case INTRINSIC_NE:
399             case INTRINSIC_NE_OS:
400               result = eq != 0;
401               break;
402
403             case INTRINSIC_GT:
404             case INTRINSIC_GT_OS:
405               result = eq > 0;
406               break;
407
408             case INTRINSIC_LT:
409             case INTRINSIC_LT_OS:
410               result = eq < 0;
411               break;
412               
413             default:
414               gfc_internal_error ("illegal OP in optimize_comparison");
415               break;
416             }
417
418           /* Replace the expression by a constant expression.  The typespec
419              and where remains the way it is.  */
420           gfc_free (op1);
421           gfc_free (op2);
422           e->expr_type = EXPR_CONSTANT;
423           e->value.logical = result;
424           return true;
425         }
426     }
427
428   return false;
429 }
430
431 /* Optimize a trim function by replacing it with an equivalent substring
432    involving a call to len_trim.  This only works for expressions where
433    variables are trimmed.  Return true if anything was modified.  */
434
435 static bool
436 optimize_trim (gfc_expr *e)
437 {
438   gfc_expr *a;
439   gfc_ref *ref;
440   gfc_expr *fcn;
441   gfc_actual_arglist *actual_arglist, *next;
442
443   /* Don't do this optimization within an argument list, because
444      otherwise aliasing issues may occur.  */
445
446   if (count_arglist != 1)
447     return false;
448
449   if (e->ts.type != BT_CHARACTER || e->expr_type != EXPR_FUNCTION
450       || e->value.function.isym == NULL
451       || e->value.function.isym->id != GFC_ISYM_TRIM)
452     return false;
453
454   a = e->value.function.actual->expr;
455
456   if (a->expr_type != EXPR_VARIABLE)
457     return false;
458
459   if (a->ref)
460     {
461       /* FIXME - also handle substring references, by modifying the
462          reference itself.  Make sure not to evaluate functions in
463          the references twice.  */
464       return false;
465     }
466   else
467     {
468       strip_function_call (e);
469
470       /* Create the reference.  */
471
472       ref = gfc_get_ref ();
473       ref->type = REF_SUBSTRING;
474
475       /* Set the start of the reference.  */
476
477       ref->u.ss.start = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
478
479       /* Build the function call to len_trim(x, gfc_defaul_integer_kind).  */
480
481       fcn = gfc_get_expr ();
482       fcn->expr_type = EXPR_FUNCTION;
483       fcn->value.function.isym =
484         gfc_intrinsic_function_by_id (GFC_ISYM_LEN_TRIM);
485       actual_arglist = gfc_get_actual_arglist ();
486       actual_arglist->expr = gfc_copy_expr (e);
487       next = gfc_get_actual_arglist ();
488       next->expr = gfc_get_int_expr (gfc_default_integer_kind, NULL,
489                                      gfc_default_integer_kind);
490       actual_arglist->next = next;
491       fcn->value.function.actual = actual_arglist;
492
493       /* Set the end of the reference to the call to len_trim.  */
494
495       ref->u.ss.end = fcn;
496       e->ref = ref;
497       return true;
498     }
499 }
500
501 #define WALK_SUBEXPR(NODE) \
502   do                                                    \
503     {                                                   \
504       result = gfc_expr_walker (&(NODE), exprfn, data); \
505       if (result)                                       \
506         return result;                                  \
507     }                                                   \
508   while (0)
509 #define WALK_SUBEXPR_TAIL(NODE) e = &(NODE); continue
510
511 /* Walk expression *E, calling EXPRFN on each expression in it.  */
512
513 int
514 gfc_expr_walker (gfc_expr **e, walk_expr_fn_t exprfn, void *data)
515 {
516   while (*e)
517     {
518       int walk_subtrees = 1;
519       gfc_actual_arglist *a;
520       gfc_ref *r;
521       gfc_constructor *c;
522
523       int result = exprfn (e, &walk_subtrees, data);
524       if (result)
525         return result;
526       if (walk_subtrees)
527         switch ((*e)->expr_type)
528           {
529           case EXPR_OP:
530             WALK_SUBEXPR ((*e)->value.op.op1);
531             WALK_SUBEXPR_TAIL ((*e)->value.op.op2);
532             break;
533           case EXPR_FUNCTION:
534             for (a = (*e)->value.function.actual; a; a = a->next)
535               WALK_SUBEXPR (a->expr);
536             break;
537           case EXPR_COMPCALL:
538           case EXPR_PPC:
539             WALK_SUBEXPR ((*e)->value.compcall.base_object);
540             for (a = (*e)->value.compcall.actual; a; a = a->next)
541               WALK_SUBEXPR (a->expr);
542             break;
543
544           case EXPR_STRUCTURE:
545           case EXPR_ARRAY:
546             for (c = gfc_constructor_first ((*e)->value.constructor); c;
547                  c = gfc_constructor_next (c))
548               {
549                 WALK_SUBEXPR (c->expr);
550                 if (c->iterator != NULL)
551                   {
552                     WALK_SUBEXPR (c->iterator->var);
553                     WALK_SUBEXPR (c->iterator->start);
554                     WALK_SUBEXPR (c->iterator->end);
555                     WALK_SUBEXPR (c->iterator->step);
556                   }
557               }
558
559             if ((*e)->expr_type != EXPR_ARRAY)
560               break;
561
562             /* Fall through to the variable case in order to walk the
563                the reference.  */
564
565           case EXPR_SUBSTRING:
566           case EXPR_VARIABLE:
567             for (r = (*e)->ref; r; r = r->next)
568               {
569                 gfc_array_ref *ar;
570                 int i;
571
572                 switch (r->type)
573                   {
574                   case REF_ARRAY:
575                     ar = &r->u.ar;
576                     if (ar->type == AR_SECTION || ar->type == AR_ELEMENT)
577                       {
578                         for (i=0; i< ar->dimen; i++)
579                           {
580                             WALK_SUBEXPR (ar->start[i]);
581                             WALK_SUBEXPR (ar->end[i]);
582                             WALK_SUBEXPR (ar->stride[i]);
583                           }
584                       }
585
586                     break;
587
588                   case REF_SUBSTRING:
589                     WALK_SUBEXPR (r->u.ss.start);
590                     WALK_SUBEXPR (r->u.ss.end);
591                     break;
592
593                   case REF_COMPONENT:
594                     break;
595                   }
596               }
597
598           default:
599             break;
600           }
601       return 0;
602     }
603   return 0;
604 }
605
606 #define WALK_SUBCODE(NODE) \
607   do                                                            \
608     {                                                           \
609       result = gfc_code_walker (&(NODE), codefn, exprfn, data); \
610       if (result)                                               \
611         return result;                                          \
612     }                                                           \
613   while (0)
614
615 /* Walk code *C, calling CODEFN on each gfc_code node in it and calling EXPRFN
616    on each expression in it.  If any of the hooks returns non-zero, that
617    value is immediately returned.  If the hook sets *WALK_SUBTREES to 0,
618    no subcodes or subexpressions are traversed.  */
619
620 int
621 gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
622                  void *data)
623 {
624   for (; *c; c = &(*c)->next)
625     {
626       int walk_subtrees = 1;
627       int result = codefn (c, &walk_subtrees, data);
628       if (result)
629         return result;
630
631       if (walk_subtrees)
632         {
633           gfc_code *b;
634           gfc_actual_arglist *a;
635
636           switch ((*c)->op)
637             {
638             case EXEC_DO:
639               WALK_SUBEXPR ((*c)->ext.iterator->var);
640               WALK_SUBEXPR ((*c)->ext.iterator->start);
641               WALK_SUBEXPR ((*c)->ext.iterator->end);
642               WALK_SUBEXPR ((*c)->ext.iterator->step);
643               break;
644
645             case EXEC_CALL:
646             case EXEC_ASSIGN_CALL:
647               for (a = (*c)->ext.actual; a; a = a->next)
648                 WALK_SUBEXPR (a->expr);
649               break;
650
651             case EXEC_CALL_PPC:
652               WALK_SUBEXPR ((*c)->expr1);
653               for (a = (*c)->ext.actual; a; a = a->next)
654                 WALK_SUBEXPR (a->expr);
655               break;
656
657             case EXEC_SELECT:
658               WALK_SUBEXPR ((*c)->expr1);
659               for (b = (*c)->block; b; b = b->block)
660                 {
661                   gfc_case *cp;
662                   for (cp = b->ext.case_list; cp; cp = cp->next)
663                     {
664                       WALK_SUBEXPR (cp->low);
665                       WALK_SUBEXPR (cp->high);
666                     }
667                   WALK_SUBCODE (b->next);
668                 }
669               continue;
670
671             case EXEC_ALLOCATE:
672             case EXEC_DEALLOCATE:
673               {
674                 gfc_alloc *a;
675                 for (a = (*c)->ext.alloc.list; a; a = a->next)
676                   WALK_SUBEXPR (a->expr);
677                 break;
678               }
679
680             case EXEC_FORALL:
681               {
682                 gfc_forall_iterator *fa;
683                 for (fa = (*c)->ext.forall_iterator; fa; fa = fa->next)
684                   {
685                     WALK_SUBEXPR (fa->var);
686                     WALK_SUBEXPR (fa->start);
687                     WALK_SUBEXPR (fa->end);
688                     WALK_SUBEXPR (fa->stride);
689                   }
690                 break;
691               }
692
693             case EXEC_OPEN:
694               WALK_SUBEXPR ((*c)->ext.open->unit);
695               WALK_SUBEXPR ((*c)->ext.open->file);
696               WALK_SUBEXPR ((*c)->ext.open->status);
697               WALK_SUBEXPR ((*c)->ext.open->access);
698               WALK_SUBEXPR ((*c)->ext.open->form);
699               WALK_SUBEXPR ((*c)->ext.open->recl);
700               WALK_SUBEXPR ((*c)->ext.open->blank);
701               WALK_SUBEXPR ((*c)->ext.open->position);
702               WALK_SUBEXPR ((*c)->ext.open->action);
703               WALK_SUBEXPR ((*c)->ext.open->delim);
704               WALK_SUBEXPR ((*c)->ext.open->pad);
705               WALK_SUBEXPR ((*c)->ext.open->iostat);
706               WALK_SUBEXPR ((*c)->ext.open->iomsg);
707               WALK_SUBEXPR ((*c)->ext.open->convert);
708               WALK_SUBEXPR ((*c)->ext.open->decimal);
709               WALK_SUBEXPR ((*c)->ext.open->encoding);
710               WALK_SUBEXPR ((*c)->ext.open->round);
711               WALK_SUBEXPR ((*c)->ext.open->sign);
712               WALK_SUBEXPR ((*c)->ext.open->asynchronous);
713               WALK_SUBEXPR ((*c)->ext.open->id);
714               WALK_SUBEXPR ((*c)->ext.open->newunit);
715               break;
716
717             case EXEC_CLOSE:
718               WALK_SUBEXPR ((*c)->ext.close->unit);
719               WALK_SUBEXPR ((*c)->ext.close->status);
720               WALK_SUBEXPR ((*c)->ext.close->iostat);
721               WALK_SUBEXPR ((*c)->ext.close->iomsg);
722               break;
723
724             case EXEC_BACKSPACE:
725             case EXEC_ENDFILE:
726             case EXEC_REWIND:
727             case EXEC_FLUSH:
728               WALK_SUBEXPR ((*c)->ext.filepos->unit);
729               WALK_SUBEXPR ((*c)->ext.filepos->iostat);
730               WALK_SUBEXPR ((*c)->ext.filepos->iomsg);
731               break;
732
733             case EXEC_INQUIRE:
734               WALK_SUBEXPR ((*c)->ext.inquire->unit);
735               WALK_SUBEXPR ((*c)->ext.inquire->file);
736               WALK_SUBEXPR ((*c)->ext.inquire->iomsg);
737               WALK_SUBEXPR ((*c)->ext.inquire->iostat);
738               WALK_SUBEXPR ((*c)->ext.inquire->exist);
739               WALK_SUBEXPR ((*c)->ext.inquire->opened);
740               WALK_SUBEXPR ((*c)->ext.inquire->number);
741               WALK_SUBEXPR ((*c)->ext.inquire->named);
742               WALK_SUBEXPR ((*c)->ext.inquire->name);
743               WALK_SUBEXPR ((*c)->ext.inquire->access);
744               WALK_SUBEXPR ((*c)->ext.inquire->sequential);
745               WALK_SUBEXPR ((*c)->ext.inquire->direct);
746               WALK_SUBEXPR ((*c)->ext.inquire->form);
747               WALK_SUBEXPR ((*c)->ext.inquire->formatted);
748               WALK_SUBEXPR ((*c)->ext.inquire->unformatted);
749               WALK_SUBEXPR ((*c)->ext.inquire->recl);
750               WALK_SUBEXPR ((*c)->ext.inquire->nextrec);
751               WALK_SUBEXPR ((*c)->ext.inquire->blank);
752               WALK_SUBEXPR ((*c)->ext.inquire->position);
753               WALK_SUBEXPR ((*c)->ext.inquire->action);
754               WALK_SUBEXPR ((*c)->ext.inquire->read);
755               WALK_SUBEXPR ((*c)->ext.inquire->write);
756               WALK_SUBEXPR ((*c)->ext.inquire->readwrite);
757               WALK_SUBEXPR ((*c)->ext.inquire->delim);
758               WALK_SUBEXPR ((*c)->ext.inquire->encoding);
759               WALK_SUBEXPR ((*c)->ext.inquire->pad);
760               WALK_SUBEXPR ((*c)->ext.inquire->iolength);
761               WALK_SUBEXPR ((*c)->ext.inquire->convert);
762               WALK_SUBEXPR ((*c)->ext.inquire->strm_pos);
763               WALK_SUBEXPR ((*c)->ext.inquire->asynchronous);
764               WALK_SUBEXPR ((*c)->ext.inquire->decimal);
765               WALK_SUBEXPR ((*c)->ext.inquire->pending);
766               WALK_SUBEXPR ((*c)->ext.inquire->id);
767               WALK_SUBEXPR ((*c)->ext.inquire->sign);
768               WALK_SUBEXPR ((*c)->ext.inquire->size);
769               WALK_SUBEXPR ((*c)->ext.inquire->round);
770               break;
771
772             case EXEC_WAIT:
773               WALK_SUBEXPR ((*c)->ext.wait->unit);
774               WALK_SUBEXPR ((*c)->ext.wait->iostat);
775               WALK_SUBEXPR ((*c)->ext.wait->iomsg);
776               WALK_SUBEXPR ((*c)->ext.wait->id);
777               break;
778
779             case EXEC_READ:
780             case EXEC_WRITE:
781               WALK_SUBEXPR ((*c)->ext.dt->io_unit);
782               WALK_SUBEXPR ((*c)->ext.dt->format_expr);
783               WALK_SUBEXPR ((*c)->ext.dt->rec);
784               WALK_SUBEXPR ((*c)->ext.dt->advance);
785               WALK_SUBEXPR ((*c)->ext.dt->iostat);
786               WALK_SUBEXPR ((*c)->ext.dt->size);
787               WALK_SUBEXPR ((*c)->ext.dt->iomsg);
788               WALK_SUBEXPR ((*c)->ext.dt->id);
789               WALK_SUBEXPR ((*c)->ext.dt->pos);
790               WALK_SUBEXPR ((*c)->ext.dt->asynchronous);
791               WALK_SUBEXPR ((*c)->ext.dt->blank);
792               WALK_SUBEXPR ((*c)->ext.dt->decimal);
793               WALK_SUBEXPR ((*c)->ext.dt->delim);
794               WALK_SUBEXPR ((*c)->ext.dt->pad);
795               WALK_SUBEXPR ((*c)->ext.dt->round);
796               WALK_SUBEXPR ((*c)->ext.dt->sign);
797               WALK_SUBEXPR ((*c)->ext.dt->extra_comma);
798               break;
799
800             case EXEC_OMP_DO:
801             case EXEC_OMP_PARALLEL:
802             case EXEC_OMP_PARALLEL_DO:
803             case EXEC_OMP_PARALLEL_SECTIONS:
804             case EXEC_OMP_PARALLEL_WORKSHARE:
805             case EXEC_OMP_SECTIONS:
806             case EXEC_OMP_SINGLE:
807             case EXEC_OMP_WORKSHARE:
808             case EXEC_OMP_END_SINGLE:
809             case EXEC_OMP_TASK:
810               if ((*c)->ext.omp_clauses)
811                 {
812                   WALK_SUBEXPR ((*c)->ext.omp_clauses->if_expr);
813                   WALK_SUBEXPR ((*c)->ext.omp_clauses->num_threads);
814                   WALK_SUBEXPR ((*c)->ext.omp_clauses->chunk_size);
815                 }
816               break;
817             default:
818               break;
819             }
820
821           WALK_SUBEXPR ((*c)->expr1);
822           WALK_SUBEXPR ((*c)->expr2);
823           WALK_SUBEXPR ((*c)->expr3);
824           for (b = (*c)->block; b; b = b->block)
825             {
826               WALK_SUBEXPR (b->expr1);
827               WALK_SUBEXPR (b->expr2);
828               WALK_SUBCODE (b->next);
829             }
830         }
831     }
832   return 0;
833 }