+ return 0;
+}
+
+#define WALK_SUBCODE(NODE) \
+ do \
+ { \
+ result = gfc_code_walker (&(NODE), codefn, exprfn, data); \
+ if (result) \
+ return result; \
+ } \
+ while (0)
+
+/* Walk code *C, calling CODEFN on each gfc_code node in it and calling EXPRFN
+ on each expression in it. If any of the hooks returns non-zero, that
+ value is immediately returned. If the hook sets *WALK_SUBTREES to 0,
+ no subcodes or subexpressions are traversed. */
+
+int
+gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
+ void *data)
+{
+ for (; *c; c = &(*c)->next)
+ {
+ int walk_subtrees = 1;
+ int result = codefn (c, &walk_subtrees, data);
+ if (result)
+ return result;
+
+ if (walk_subtrees)
+ {
+ gfc_code *b;
+ gfc_actual_arglist *a;
+ gfc_code *co;
+ gfc_association_list *alist;
+ bool saved_in_omp_workshare;
+
+ /* There might be statement insertions before the current code,
+ which must not affect the expression walker. */
+
+ co = *c;
+ saved_in_omp_workshare = in_omp_workshare;
+
+ switch (co->op)
+ {
+
+ case EXEC_BLOCK:
+ WALK_SUBCODE (co->ext.block.ns->code);
+ if (co->ext.block.assoc)
+ {
+ bool saved_in_assoc_list = in_assoc_list;
+
+ in_assoc_list = true;
+ for (alist = co->ext.block.assoc; alist; alist = alist->next)
+ WALK_SUBEXPR (alist->target);
+
+ in_assoc_list = saved_in_assoc_list;
+ }
+
+ break;
+
+ case EXEC_DO:
+ doloop_level ++;
+ WALK_SUBEXPR (co->ext.iterator->var);
+ WALK_SUBEXPR (co->ext.iterator->start);
+ WALK_SUBEXPR (co->ext.iterator->end);
+ WALK_SUBEXPR (co->ext.iterator->step);
+ break;
+
+ case EXEC_CALL:
+ case EXEC_ASSIGN_CALL:
+ for (a = co->ext.actual; a; a = a->next)
+ WALK_SUBEXPR (a->expr);
+ break;
+
+ case EXEC_CALL_PPC:
+ WALK_SUBEXPR (co->expr1);
+ for (a = co->ext.actual; a; a = a->next)
+ WALK_SUBEXPR (a->expr);
+ break;
+
+ case EXEC_SELECT:
+ WALK_SUBEXPR (co->expr1);
+ for (b = co->block; b; b = b->block)
+ {
+ gfc_case *cp;
+ for (cp = b->ext.block.case_list; cp; cp = cp->next)
+ {
+ WALK_SUBEXPR (cp->low);
+ WALK_SUBEXPR (cp->high);
+ }
+ WALK_SUBCODE (b->next);
+ }
+ continue;
+
+ case EXEC_ALLOCATE:
+ case EXEC_DEALLOCATE:
+ {
+ gfc_alloc *a;
+ for (a = co->ext.alloc.list; a; a = a->next)
+ WALK_SUBEXPR (a->expr);
+ break;
+ }
+
+ case EXEC_FORALL:
+ case EXEC_DO_CONCURRENT:
+ {
+ gfc_forall_iterator *fa;
+ for (fa = co->ext.forall_iterator; fa; fa = fa->next)
+ {
+ WALK_SUBEXPR (fa->var);
+ WALK_SUBEXPR (fa->start);
+ WALK_SUBEXPR (fa->end);
+ WALK_SUBEXPR (fa->stride);
+ }
+ if (co->op == EXEC_FORALL)
+ forall_level ++;
+ break;
+ }
+
+ case EXEC_OPEN:
+ WALK_SUBEXPR (co->ext.open->unit);
+ WALK_SUBEXPR (co->ext.open->file);
+ WALK_SUBEXPR (co->ext.open->status);
+ WALK_SUBEXPR (co->ext.open->access);
+ WALK_SUBEXPR (co->ext.open->form);
+ WALK_SUBEXPR (co->ext.open->recl);
+ WALK_SUBEXPR (co->ext.open->blank);
+ WALK_SUBEXPR (co->ext.open->position);
+ WALK_SUBEXPR (co->ext.open->action);
+ WALK_SUBEXPR (co->ext.open->delim);
+ WALK_SUBEXPR (co->ext.open->pad);
+ WALK_SUBEXPR (co->ext.open->iostat);
+ WALK_SUBEXPR (co->ext.open->iomsg);
+ WALK_SUBEXPR (co->ext.open->convert);
+ WALK_SUBEXPR (co->ext.open->decimal);
+ WALK_SUBEXPR (co->ext.open->encoding);
+ WALK_SUBEXPR (co->ext.open->round);
+ WALK_SUBEXPR (co->ext.open->sign);
+ WALK_SUBEXPR (co->ext.open->asynchronous);
+ WALK_SUBEXPR (co->ext.open->id);
+ WALK_SUBEXPR (co->ext.open->newunit);
+ break;
+
+ case EXEC_CLOSE:
+ WALK_SUBEXPR (co->ext.close->unit);
+ WALK_SUBEXPR (co->ext.close->status);
+ WALK_SUBEXPR (co->ext.close->iostat);
+ WALK_SUBEXPR (co->ext.close->iomsg);
+ break;
+
+ case EXEC_BACKSPACE:
+ case EXEC_ENDFILE:
+ case EXEC_REWIND:
+ case EXEC_FLUSH:
+ WALK_SUBEXPR (co->ext.filepos->unit);
+ WALK_SUBEXPR (co->ext.filepos->iostat);
+ WALK_SUBEXPR (co->ext.filepos->iomsg);
+ break;
+
+ case EXEC_INQUIRE:
+ WALK_SUBEXPR (co->ext.inquire->unit);
+ WALK_SUBEXPR (co->ext.inquire->file);
+ WALK_SUBEXPR (co->ext.inquire->iomsg);
+ WALK_SUBEXPR (co->ext.inquire->iostat);
+ WALK_SUBEXPR (co->ext.inquire->exist);
+ WALK_SUBEXPR (co->ext.inquire->opened);
+ WALK_SUBEXPR (co->ext.inquire->number);
+ WALK_SUBEXPR (co->ext.inquire->named);
+ WALK_SUBEXPR (co->ext.inquire->name);
+ WALK_SUBEXPR (co->ext.inquire->access);
+ WALK_SUBEXPR (co->ext.inquire->sequential);
+ WALK_SUBEXPR (co->ext.inquire->direct);
+ WALK_SUBEXPR (co->ext.inquire->form);
+ WALK_SUBEXPR (co->ext.inquire->formatted);
+ WALK_SUBEXPR (co->ext.inquire->unformatted);
+ WALK_SUBEXPR (co->ext.inquire->recl);
+ WALK_SUBEXPR (co->ext.inquire->nextrec);
+ WALK_SUBEXPR (co->ext.inquire->blank);
+ WALK_SUBEXPR (co->ext.inquire->position);
+ WALK_SUBEXPR (co->ext.inquire->action);
+ WALK_SUBEXPR (co->ext.inquire->read);
+ WALK_SUBEXPR (co->ext.inquire->write);
+ WALK_SUBEXPR (co->ext.inquire->readwrite);
+ WALK_SUBEXPR (co->ext.inquire->delim);
+ WALK_SUBEXPR (co->ext.inquire->encoding);
+ WALK_SUBEXPR (co->ext.inquire->pad);
+ WALK_SUBEXPR (co->ext.inquire->iolength);
+ WALK_SUBEXPR (co->ext.inquire->convert);
+ WALK_SUBEXPR (co->ext.inquire->strm_pos);
+ WALK_SUBEXPR (co->ext.inquire->asynchronous);
+ WALK_SUBEXPR (co->ext.inquire->decimal);
+ WALK_SUBEXPR (co->ext.inquire->pending);
+ WALK_SUBEXPR (co->ext.inquire->id);
+ WALK_SUBEXPR (co->ext.inquire->sign);
+ WALK_SUBEXPR (co->ext.inquire->size);
+ WALK_SUBEXPR (co->ext.inquire->round);
+ break;
+
+ case EXEC_WAIT:
+ WALK_SUBEXPR (co->ext.wait->unit);
+ WALK_SUBEXPR (co->ext.wait->iostat);
+ WALK_SUBEXPR (co->ext.wait->iomsg);
+ WALK_SUBEXPR (co->ext.wait->id);
+ break;
+
+ case EXEC_READ:
+ case EXEC_WRITE:
+ WALK_SUBEXPR (co->ext.dt->io_unit);
+ WALK_SUBEXPR (co->ext.dt->format_expr);
+ WALK_SUBEXPR (co->ext.dt->rec);
+ WALK_SUBEXPR (co->ext.dt->advance);
+ WALK_SUBEXPR (co->ext.dt->iostat);
+ WALK_SUBEXPR (co->ext.dt->size);
+ WALK_SUBEXPR (co->ext.dt->iomsg);
+ WALK_SUBEXPR (co->ext.dt->id);
+ WALK_SUBEXPR (co->ext.dt->pos);
+ WALK_SUBEXPR (co->ext.dt->asynchronous);
+ WALK_SUBEXPR (co->ext.dt->blank);
+ WALK_SUBEXPR (co->ext.dt->decimal);
+ WALK_SUBEXPR (co->ext.dt->delim);
+ WALK_SUBEXPR (co->ext.dt->pad);
+ WALK_SUBEXPR (co->ext.dt->round);
+ WALK_SUBEXPR (co->ext.dt->sign);
+ WALK_SUBEXPR (co->ext.dt->extra_comma);
+ break;
+
+ case EXEC_OMP_PARALLEL:
+ case EXEC_OMP_PARALLEL_DO:
+ case EXEC_OMP_PARALLEL_DO_SIMD:
+ case EXEC_OMP_PARALLEL_SECTIONS:
+
+ in_omp_workshare = false;
+
+ /* This goto serves as a shortcut to avoid code
+ duplication or a larger if or switch statement. */
+ goto check_omp_clauses;
+
+ case EXEC_OMP_WORKSHARE:
+ case EXEC_OMP_PARALLEL_WORKSHARE:
+
+ in_omp_workshare = true;
+
+ /* Fall through */
+
+ case EXEC_OMP_DISTRIBUTE:
+ case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
+ case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
+ case EXEC_OMP_DISTRIBUTE_SIMD:
+ case EXEC_OMP_DO:
+ case EXEC_OMP_DO_SIMD:
+ case EXEC_OMP_SECTIONS:
+ case EXEC_OMP_SINGLE:
+ case EXEC_OMP_END_SINGLE:
+ case EXEC_OMP_SIMD:
+ case EXEC_OMP_TARGET:
+ case EXEC_OMP_TARGET_DATA:
+ case EXEC_OMP_TARGET_TEAMS:
+ case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
+ case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
+ case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
+ case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+ case EXEC_OMP_TARGET_UPDATE:
+ case EXEC_OMP_TASK:
+ case EXEC_OMP_TEAMS:
+ case EXEC_OMP_TEAMS_DISTRIBUTE:
+ case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
+ case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
+ case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
+
+ /* Come to this label only from the
+ EXEC_OMP_PARALLEL_* cases above. */
+
+ check_omp_clauses:
+
+ if (co->ext.omp_clauses)
+ {
+ gfc_omp_namelist *n;
+ static int list_types[]
+ = { OMP_LIST_ALIGNED, OMP_LIST_LINEAR, OMP_LIST_DEPEND,
+ OMP_LIST_MAP, OMP_LIST_TO, OMP_LIST_FROM };
+ size_t idx;
+ WALK_SUBEXPR (co->ext.omp_clauses->if_expr);
+ WALK_SUBEXPR (co->ext.omp_clauses->final_expr);
+ WALK_SUBEXPR (co->ext.omp_clauses->num_threads);
+ WALK_SUBEXPR (co->ext.omp_clauses->chunk_size);
+ WALK_SUBEXPR (co->ext.omp_clauses->safelen_expr);
+ WALK_SUBEXPR (co->ext.omp_clauses->simdlen_expr);
+ WALK_SUBEXPR (co->ext.omp_clauses->num_teams);
+ WALK_SUBEXPR (co->ext.omp_clauses->device);
+ WALK_SUBEXPR (co->ext.omp_clauses->thread_limit);
+ WALK_SUBEXPR (co->ext.omp_clauses->dist_chunk_size);
+ for (idx = 0;
+ idx < sizeof (list_types) / sizeof (list_types[0]);
+ idx++)
+ for (n = co->ext.omp_clauses->lists[list_types[idx]];
+ n; n = n->next)
+ WALK_SUBEXPR (n->expr);
+ }
+ break;
+ default:
+ break;
+ }
+
+ WALK_SUBEXPR (co->expr1);
+ WALK_SUBEXPR (co->expr2);
+ WALK_SUBEXPR (co->expr3);
+ WALK_SUBEXPR (co->expr4);
+ for (b = co->block; b; b = b->block)
+ {
+ WALK_SUBEXPR (b->expr1);
+ WALK_SUBEXPR (b->expr2);
+ WALK_SUBCODE (b->next);
+ }
+
+ if (co->op == EXEC_FORALL)
+ forall_level --;
+
+ if (co->op == EXEC_DO)
+ doloop_level --;
+
+ in_omp_workshare = saved_in_omp_workshare;
+ }
+ }
+ return 0;