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