?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
* match.c (gfc_match_name): Expanded comment.
[official-gcc.git] / gcc / fortran / openmp.c
blob42b5aa15dba7453ffcc71ea0d388f0e07a4554ef
1 /* OpenMP directive matching and resolving.
2 Copyright (C) 2005, 2006, 2007
3 Free Software Foundation, Inc.
4 Contributed by Jakub Jelinek
5
6 This file is part of GCC.
7
8 GCC is free software; you can redistribute it and/or modify it under
9 the terms of the GNU General Public License as published by the Free
10 Software Foundation; either version 2, or (at your option) any later
11 version.
12
13 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
14 WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16 for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with GCC; see the file COPYING. If not, write to the Free
20 Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
21 02110-1301, USA. */
22
23 #include "config.h"
24 #include "system.h"
25 #include "flags.h"
26 #include "gfortran.h"
27 #include "match.h"
28 #include "parse.h"
29 #include "pointer-set.h"
30 #include "target.h"
31 #include "toplev.h"
32
33 /* Match an end of OpenMP directive. End of OpenMP directive is optional
34 whitespace, followed by '\n' or comment '!'. */
35
36 match
37 gfc_match_omp_eos (void)
38 {
39 locus old_loc;
40 int c;
41
42 old_loc = gfc_current_locus;
43 gfc_gobble_whitespace ();
44
45 c = gfc_next_char ();
46 switch (c)
47 {
48 case '!':
49 do
50 c = gfc_next_char ();
51 while (c != '\n');
52 /* Fall through */
53
54 case '\n':
55 return MATCH_YES;
56 }
57
58 gfc_current_locus = old_loc;
59 return MATCH_NO;
60 }
61
62 /* Free an omp_clauses structure. */
63
64 void
65 gfc_free_omp_clauses (gfc_omp_clauses *c)
66 {
67 int i;
68 if (c == NULL)
69 return;
70
71 gfc_free_expr (c->if_expr);
72 gfc_free_expr (c->num_threads);
73 gfc_free_expr (c->chunk_size);
74 for (i = 0; i < OMP_LIST_NUM; i++)
75 gfc_free_namelist (c->lists[i]);
76 gfc_free (c);
77 }
78
79 /* Match a variable/common block list and construct a namelist from it. */
80
81 static match
82 gfc_match_omp_variable_list (const char *str, gfc_namelist **list,
83 bool allow_common)
84 {
85 gfc_namelist *head, *tail, *p;
86 locus old_loc;
87 char n[GFC_MAX_SYMBOL_LEN+1];
88 gfc_symbol *sym;
89 match m;
90 gfc_symtree *st;
91
92 head = tail = NULL;
93
94 old_loc = gfc_current_locus;
95
96 m = gfc_match (str);
97 if (m != MATCH_YES)
98 return m;
99
100 for (;;)
101 {
102 m = gfc_match_symbol (&sym, 1);
103 switch (m)
104 {
105 case MATCH_YES:
106 gfc_set_sym_referenced (sym);
107 p = gfc_get_namelist ();
108 if (head == NULL)
109 head = tail = p;
110 else
111 {
112 tail->next = p;
113 tail = tail->next;
114 }
115 tail->sym = sym;
116 goto next_item;
117 case MATCH_NO:
118 break;
119 case MATCH_ERROR:
120 goto cleanup;
121 }
122
123 if (!allow_common)
124 goto syntax;
125
126 m = gfc_match (" / %n /", n);
127 if (m == MATCH_ERROR)
128 goto cleanup;
129 if (m == MATCH_NO)
130 goto syntax;
131
132 st = gfc_find_symtree (gfc_current_ns->common_root, n);
133 if (st == NULL)
134 {
135 gfc_error ("COMMON block /%s/ not found at %C", n);
136 goto cleanup;
137 }
138 for (sym = st->n.common->head; sym; sym = sym->common_next)
139 {
140 gfc_set_sym_referenced (sym);
141 p = gfc_get_namelist ();
142 if (head == NULL)
143 head = tail = p;
144 else
145 {
146 tail->next = p;
147 tail = tail->next;
148 }
149 tail->sym = sym;
150 }
151
152 next_item:
153 if (gfc_match_char (')') == MATCH_YES)
154 break;
155 if (gfc_match_char (',') != MATCH_YES)
156 goto syntax;
157 }
158
159 while (*list)
160 list = &(*list)->next;
161
162 *list = head;
163 return MATCH_YES;
164
165 syntax:
166 gfc_error ("Syntax error in OpenMP variable list at %C");
167
168 cleanup:
169 gfc_free_namelist (head);
170 gfc_current_locus = old_loc;
171 return MATCH_ERROR;
172 }
173
174 #define OMP_CLAUSE_PRIVATE (1 << 0)
175 #define OMP_CLAUSE_FIRSTPRIVATE (1 << 1)
176 #define OMP_CLAUSE_LASTPRIVATE (1 << 2)
177 #define OMP_CLAUSE_COPYPRIVATE (1 << 3)
178 #define OMP_CLAUSE_SHARED (1 << 4)
179 #define OMP_CLAUSE_COPYIN (1 << 5)
180 #define OMP_CLAUSE_REDUCTION (1 << 6)
181 #define OMP_CLAUSE_IF (1 << 7)
182 #define OMP_CLAUSE_NUM_THREADS (1 << 8)
183 #define OMP_CLAUSE_SCHEDULE (1 << 9)
184 #define OMP_CLAUSE_DEFAULT (1 << 10)
185 #define OMP_CLAUSE_ORDERED (1 << 11)
186
187 /* Match OpenMP directive clauses. MASK is a bitmask of
188 clauses that are allowed for a particular directive. */
189
190 static match
191 gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
192 {
193 gfc_omp_clauses *c = gfc_get_omp_clauses ();
194 locus old_loc;
195 bool needs_space = true, first = true;
196
197 *cp = NULL;
198 while (1)
199 {
200 if ((first || gfc_match_char (',') != MATCH_YES)
201 && (needs_space && gfc_match_space () != MATCH_YES))
202 break;
203 needs_space = false;
204 first = false;
205 gfc_gobble_whitespace ();
206 if ((mask & OMP_CLAUSE_IF) && c->if_expr == NULL
207 && gfc_match ("if ( %e )", &c->if_expr) == MATCH_YES)
208 continue;
209 if ((mask & OMP_CLAUSE_NUM_THREADS) && c->num_threads == NULL
210 && gfc_match ("num_threads ( %e )", &c->num_threads) == MATCH_YES)
211 continue;
212 if ((mask & OMP_CLAUSE_PRIVATE)
213 && gfc_match_omp_variable_list ("private (",
214 &c->lists[OMP_LIST_PRIVATE], true)
215 == MATCH_YES)
216 continue;
217 if ((mask & OMP_CLAUSE_FIRSTPRIVATE)
218 && gfc_match_omp_variable_list ("firstprivate (",
219 &c->lists[OMP_LIST_FIRSTPRIVATE],
220 true)
221 == MATCH_YES)
222 continue;
223 if ((mask & OMP_CLAUSE_LASTPRIVATE)
224 && gfc_match_omp_variable_list ("lastprivate (",
225 &c->lists[OMP_LIST_LASTPRIVATE],
226 true)
227 == MATCH_YES)
228 continue;
229 if ((mask & OMP_CLAUSE_COPYPRIVATE)
230 && gfc_match_omp_variable_list ("copyprivate (",
231 &c->lists[OMP_LIST_COPYPRIVATE],
232 true)
233 == MATCH_YES)
234 continue;
235 if ((mask & OMP_CLAUSE_SHARED)
236 && gfc_match_omp_variable_list ("shared (",
237 &c->lists[OMP_LIST_SHARED], true)
238 == MATCH_YES)
239 continue;
240 if ((mask & OMP_CLAUSE_COPYIN)
241 && gfc_match_omp_variable_list ("copyin (",
242 &c->lists[OMP_LIST_COPYIN], true)
243 == MATCH_YES)
244 continue;
245 old_loc = gfc_current_locus;
246 if ((mask & OMP_CLAUSE_REDUCTION)
247 && gfc_match ("reduction ( ") == MATCH_YES)
248 {
249 int reduction = OMP_LIST_NUM;
250 char buffer[GFC_MAX_SYMBOL_LEN + 1];
251 if (gfc_match_char ('+') == MATCH_YES)
252 reduction = OMP_LIST_PLUS;
253 else if (gfc_match_char ('*') == MATCH_YES)
254 reduction = OMP_LIST_MULT;
255 else if (gfc_match_char ('-') == MATCH_YES)
256 reduction = OMP_LIST_SUB;
257 else if (gfc_match (".and.") == MATCH_YES)
258 reduction = OMP_LIST_AND;
259 else if (gfc_match (".or.") == MATCH_YES)
260 reduction = OMP_LIST_OR;
261 else if (gfc_match (".eqv.") == MATCH_YES)
262 reduction = OMP_LIST_EQV;
263 else if (gfc_match (".neqv.") == MATCH_YES)
264 reduction = OMP_LIST_NEQV;
265 else if (gfc_match_name (buffer) == MATCH_YES)
266 {
267 gfc_symbol *sym;
268 const char *n = buffer;
269
270 gfc_find_symbol (buffer, NULL, 1, &sym);
271 if (sym != NULL)
272 {
273 if (sym->attr.intrinsic)
274 n = sym->name;
275 else if ((sym->attr.flavor != FL_UNKNOWN
276 && sym->attr.flavor != FL_PROCEDURE)
277 || sym->attr.external
278 || sym->attr.generic
279 || sym->attr.entry
280 || sym->attr.result
281 || sym->attr.dummy
282 || sym->attr.subroutine
283 || sym->attr.pointer
284 || sym->attr.target
285 || sym->attr.cray_pointer
286 || sym->attr.cray_pointee
287 || (sym->attr.proc != PROC_UNKNOWN
288 && sym->attr.proc != PROC_INTRINSIC)
289 || sym->attr.if_source != IFSRC_UNKNOWN
290 || sym == sym->ns->proc_name)
291 {
292 gfc_error_now ("%s is not INTRINSIC procedure name "
293 "at %C", buffer);
294 sym = NULL;
295 }
296 else
297 n = sym->name;
298 }
299 if (strcmp (n, "max") == 0)
300 reduction = OMP_LIST_MAX;
301 else if (strcmp (n, "min") == 0)
302 reduction = OMP_LIST_MIN;
303 else if (strcmp (n, "iand") == 0)
304 reduction = OMP_LIST_IAND;
305 else if (strcmp (n, "ior") == 0)
306 reduction = OMP_LIST_IOR;
307 else if (strcmp (n, "ieor") == 0)
308 reduction = OMP_LIST_IEOR;
309 if (reduction != OMP_LIST_NUM
310 && sym != NULL
311 && ! sym->attr.intrinsic
312 && ! sym->attr.use_assoc
313 && ((sym->attr.flavor == FL_UNKNOWN
314 && gfc_add_flavor (&sym->attr, FL_PROCEDURE,
315 sym->name, NULL) == FAILURE)
316 || gfc_add_intrinsic (&sym->attr, NULL) == FAILURE))
317 {
318 gfc_free_omp_clauses (c);
319 return MATCH_ERROR;
320 }
321 }
322 if (reduction != OMP_LIST_NUM
323 && gfc_match_omp_variable_list (" :", &c->lists[reduction],
324 false)
325 == MATCH_YES)
326 continue;
327 else
328 gfc_current_locus = old_loc;
329 }
330 if ((mask & OMP_CLAUSE_DEFAULT)
331 && c->default_sharing == OMP_DEFAULT_UNKNOWN)
332 {
333 if (gfc_match ("default ( shared )") == MATCH_YES)
334 c->default_sharing = OMP_DEFAULT_SHARED;
335 else if (gfc_match ("default ( private )") == MATCH_YES)
336 c->default_sharing = OMP_DEFAULT_PRIVATE;
337 else if (gfc_match ("default ( none )") == MATCH_YES)
338 c->default_sharing = OMP_DEFAULT_NONE;
339 if (c->default_sharing != OMP_DEFAULT_UNKNOWN)
340 continue;
341 }
342 old_loc = gfc_current_locus;
343 if ((mask & OMP_CLAUSE_SCHEDULE)
344 && c->sched_kind == OMP_SCHED_NONE
345 && gfc_match ("schedule ( ") == MATCH_YES)
346 {
347 if (gfc_match ("static") == MATCH_YES)
348 c->sched_kind = OMP_SCHED_STATIC;
349 else if (gfc_match ("dynamic") == MATCH_YES)
350 c->sched_kind = OMP_SCHED_DYNAMIC;
351 else if (gfc_match ("guided") == MATCH_YES)
352 c->sched_kind = OMP_SCHED_GUIDED;
353 else if (gfc_match ("runtime") == MATCH_YES)
354 c->sched_kind = OMP_SCHED_RUNTIME;
355 if (c->sched_kind != OMP_SCHED_NONE)
356 {
357 match m = MATCH_NO;
358 if (c->sched_kind != OMP_SCHED_RUNTIME)
359 m = gfc_match (" , %e )", &c->chunk_size);
360 if (m != MATCH_YES)
361 m = gfc_match_char (')');
362 if (m != MATCH_YES)
363 c->sched_kind = OMP_SCHED_NONE;
364 }
365 if (c->sched_kind != OMP_SCHED_NONE)
366 continue;
367 else
368 gfc_current_locus = old_loc;
369 }
370 if ((mask & OMP_CLAUSE_ORDERED) && !c->ordered
371 && gfc_match ("ordered") == MATCH_YES)
372 {
373 c->ordered = needs_space = true;
374 continue;
375 }
376
377 break;
378 }
379
380 if (gfc_match_omp_eos () != MATCH_YES)
381 {
382 gfc_free_omp_clauses (c);
383 return MATCH_ERROR;
384 }
385
386 *cp = c;
387 return MATCH_YES;
388 }
389
390 #define OMP_PARALLEL_CLAUSES \
391 (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \
392 | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IF \
393 | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT)
394 #define OMP_DO_CLAUSES \
395 (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \
396 | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \
397 | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED)
398 #define OMP_SECTIONS_CLAUSES \
399 (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \
400 | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
401
402 match
403 gfc_match_omp_parallel (void)
404 {
405 gfc_omp_clauses *c;
406 if (gfc_match_omp_clauses (&c, OMP_PARALLEL_CLAUSES) != MATCH_YES)
407 return MATCH_ERROR;
408 new_st.op = EXEC_OMP_PARALLEL;
409 new_st.ext.omp_clauses = c;
410 return MATCH_YES;
411 }
412
413
414 match
415 gfc_match_omp_critical (void)
416 {
417 char n[GFC_MAX_SYMBOL_LEN+1];
418
419 if (gfc_match (" ( %n )", n) != MATCH_YES)
420 n[0] = '\0';
421 if (gfc_match_omp_eos () != MATCH_YES)
422 return MATCH_ERROR;
423 new_st.op = EXEC_OMP_CRITICAL;
424 new_st.ext.omp_name = n[0] ? xstrdup (n) : NULL;
425 return MATCH_YES;
426 }
427
428
429 match
430 gfc_match_omp_do (void)
431 {
432 gfc_omp_clauses *c;
433 if (gfc_match_omp_clauses (&c, OMP_DO_CLAUSES) != MATCH_YES)
434 return MATCH_ERROR;
435 new_st.op = EXEC_OMP_DO;
436 new_st.ext.omp_clauses = c;
437 return MATCH_YES;
438 }
439
440
441 match
442 gfc_match_omp_flush (void)
443 {
444 gfc_namelist *list = NULL;
445 gfc_match_omp_variable_list (" (", &list, true);
446 if (gfc_match_omp_eos () != MATCH_YES)
447 {
448 gfc_free_namelist (list);
449 return MATCH_ERROR;
450 }
451 new_st.op = EXEC_OMP_FLUSH;
452 new_st.ext.omp_namelist = list;
453 return MATCH_YES;
454 }
455
456
457 match
458 gfc_match_omp_threadprivate (void)
459 {
460 locus old_loc;
461 char n[GFC_MAX_SYMBOL_LEN+1];
462 gfc_symbol *sym;
463 match m;
464 gfc_symtree *st;
465
466 old_loc = gfc_current_locus;
467
468 m = gfc_match (" (");
469 if (m != MATCH_YES)
470 return m;
471
472 for (;;)
473 {
474 m = gfc_match_symbol (&sym, 0);
475 switch (m)
476 {
477 case MATCH_YES:
478 if (sym->attr.in_common)
479 gfc_error_now ("Threadprivate variable at %C is an element of "
480 "a COMMON block");
481 else if (gfc_add_threadprivate (&sym->attr, sym->name,
482 &sym->declared_at) == FAILURE)
483 goto cleanup;
484 goto next_item;
485 case MATCH_NO:
486 break;
487 case MATCH_ERROR:
488 goto cleanup;
489 }
490
491 m = gfc_match (" / %n /", n);
492 if (m == MATCH_ERROR)
493 goto cleanup;
494 if (m == MATCH_NO || n[0] == '\0')
495 goto syntax;
496
497 st = gfc_find_symtree (gfc_current_ns->common_root, n);
498 if (st == NULL)
499 {
500 gfc_error ("COMMON block /%s/ not found at %C", n);
501 goto cleanup;
502 }
503 st->n.common->threadprivate = 1;
504 for (sym = st->n.common->head; sym; sym = sym->common_next)
505 if (gfc_add_threadprivate (&sym->attr, sym->name,
506 &sym->declared_at) == FAILURE)
507 goto cleanup;
508
509 next_item:
510 if (gfc_match_char (')') == MATCH_YES)
511 break;
512 if (gfc_match_char (',') != MATCH_YES)
513 goto syntax;
514 }
515
516 return MATCH_YES;
517
518 syntax:
519 gfc_error ("Syntax error in !$OMP THREADPRIVATE list at %C");
520
521 cleanup:
522 gfc_current_locus = old_loc;
523 return MATCH_ERROR;
524 }
525
526
527 match
528 gfc_match_omp_parallel_do (void)
529 {
530 gfc_omp_clauses *c;
531 if (gfc_match_omp_clauses (&c, OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES)
532 != MATCH_YES)
533 return MATCH_ERROR;
534 new_st.op = EXEC_OMP_PARALLEL_DO;
535 new_st.ext.omp_clauses = c;
536 return MATCH_YES;
537 }
538
539
540 match
541 gfc_match_omp_parallel_sections (void)
542 {
543 gfc_omp_clauses *c;
544 if (gfc_match_omp_clauses (&c, OMP_PARALLEL_CLAUSES | OMP_SECTIONS_CLAUSES)
545 != MATCH_YES)
546 return MATCH_ERROR;
547 new_st.op = EXEC_OMP_PARALLEL_SECTIONS;
548 new_st.ext.omp_clauses = c;
549 return MATCH_YES;
550 }
551
552
553 match
554 gfc_match_omp_parallel_workshare (void)
555 {
556 gfc_omp_clauses *c;
557 if (gfc_match_omp_clauses (&c, OMP_PARALLEL_CLAUSES) != MATCH_YES)
558 return MATCH_ERROR;
559 new_st.op = EXEC_OMP_PARALLEL_WORKSHARE;
560 new_st.ext.omp_clauses = c;
561 return MATCH_YES;
562 }
563
564
565 match
566 gfc_match_omp_sections (void)
567 {
568 gfc_omp_clauses *c;
569 if (gfc_match_omp_clauses (&c, OMP_SECTIONS_CLAUSES) != MATCH_YES)
570 return MATCH_ERROR;
571 new_st.op = EXEC_OMP_SECTIONS;
572 new_st.ext.omp_clauses = c;
573 return MATCH_YES;
574 }
575
576
577 match
578 gfc_match_omp_single (void)
579 {
580 gfc_omp_clauses *c;
581 if (gfc_match_omp_clauses (&c, OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE)
582 != MATCH_YES)
583 return MATCH_ERROR;
584 new_st.op = EXEC_OMP_SINGLE;
585 new_st.ext.omp_clauses = c;
586 return MATCH_YES;
587 }
588
589
590 match
591 gfc_match_omp_workshare (void)
592 {
593 if (gfc_match_omp_eos () != MATCH_YES)
594 return MATCH_ERROR;
595 new_st.op = EXEC_OMP_WORKSHARE;
596 new_st.ext.omp_clauses = gfc_get_omp_clauses ();
597 return MATCH_YES;
598 }
599
600
601 match
602 gfc_match_omp_master (void)
603 {
604 if (gfc_match_omp_eos () != MATCH_YES)
605 return MATCH_ERROR;
606 new_st.op = EXEC_OMP_MASTER;
607 new_st.ext.omp_clauses = NULL;
608 return MATCH_YES;
609 }
610
611
612 match
613 gfc_match_omp_ordered (void)
614 {
615 if (gfc_match_omp_eos () != MATCH_YES)
616 return MATCH_ERROR;
617 new_st.op = EXEC_OMP_ORDERED;
618 new_st.ext.omp_clauses = NULL;
619 return MATCH_YES;
620 }
621
622
623 match
624 gfc_match_omp_atomic (void)
625 {
626 if (gfc_match_omp_eos () != MATCH_YES)
627 return MATCH_ERROR;
628 new_st.op = EXEC_OMP_ATOMIC;
629 new_st.ext.omp_clauses = NULL;
630 return MATCH_YES;
631 }
632
633
634 match
635 gfc_match_omp_barrier (void)
636 {
637 if (gfc_match_omp_eos () != MATCH_YES)
638 return MATCH_ERROR;
639 new_st.op = EXEC_OMP_BARRIER;
640 new_st.ext.omp_clauses = NULL;
641 return MATCH_YES;
642 }
643
644
645 match
646 gfc_match_omp_end_nowait (void)
647 {
648 bool nowait = false;
649 if (gfc_match ("% nowait") == MATCH_YES)
650 nowait = true;
651 if (gfc_match_omp_eos () != MATCH_YES)
652 return MATCH_ERROR;
653 new_st.op = EXEC_OMP_END_NOWAIT;
654 new_st.ext.omp_bool = nowait;
655 return MATCH_YES;
656 }
657
658
659 match
660 gfc_match_omp_end_single (void)
661 {
662 gfc_omp_clauses *c;
663 if (gfc_match ("% nowait") == MATCH_YES)
664 {
665 new_st.op = EXEC_OMP_END_NOWAIT;
666 new_st.ext.omp_bool = true;
667 return MATCH_YES;
668 }
669 if (gfc_match_omp_clauses (&c, OMP_CLAUSE_COPYPRIVATE) != MATCH_YES)
670 return MATCH_ERROR;
671 new_st.op = EXEC_OMP_END_SINGLE;
672 new_st.ext.omp_clauses = c;
673 return MATCH_YES;
674 }
675
676
677 /* OpenMP directive resolving routines. */
678
679 static void
680 resolve_omp_clauses (gfc_code *code)
681 {
682 gfc_omp_clauses *omp_clauses = code->ext.omp_clauses;
683 gfc_namelist *n;
684 int list;
685 static const char *clause_names[]
686 = { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED",
687 "COPYIN", "REDUCTION" };
688
689 if (omp_clauses == NULL)
690 return;
691
692 if (omp_clauses->if_expr)
693 {
694 gfc_expr *expr = omp_clauses->if_expr;
695 if (gfc_resolve_expr (expr) == FAILURE
696 || expr->ts.type != BT_LOGICAL || expr->rank != 0)
697 gfc_error ("IF clause at %L requires a scalar LOGICAL expression",
698 &expr->where);
699 }
700 if (omp_clauses->num_threads)
701 {
702 gfc_expr *expr = omp_clauses->num_threads;
703 if (gfc_resolve_expr (expr) == FAILURE
704 || expr->ts.type != BT_INTEGER || expr->rank != 0)
705 gfc_error ("NUM_THREADS clause at %L requires a scalar "
706 "INTEGER expression", &expr->where);
707 }
708 if (omp_clauses->chunk_size)
709 {
710 gfc_expr *expr = omp_clauses->chunk_size;
711 if (gfc_resolve_expr (expr) == FAILURE
712 || expr->ts.type != BT_INTEGER || expr->rank != 0)
713 gfc_error ("SCHEDULE clause's chunk_size at %L requires "
714 "a scalar INTEGER expression", &expr->where);
715 }
716
717 /* Check that no symbol appears on multiple clauses, except that
718 a symbol can appear on both firstprivate and lastprivate. */
719 for (list = 0; list < OMP_LIST_NUM; list++)
720 for (n = omp_clauses->lists[list]; n; n = n->next)
721 n->sym->mark = 0;
722
723 for (list = 0; list < OMP_LIST_NUM; list++)
724 if (list != OMP_LIST_FIRSTPRIVATE && list != OMP_LIST_LASTPRIVATE)
725 for (n = omp_clauses->lists[list]; n; n = n->next)
726 if (n->sym->mark)
727 gfc_error ("Symbol '%s' present on multiple clauses at %L",
728 n->sym->name, &code->loc);
729 else
730 n->sym->mark = 1;
731
732 gcc_assert (OMP_LIST_LASTPRIVATE == OMP_LIST_FIRSTPRIVATE + 1);
733 for (list = OMP_LIST_FIRSTPRIVATE; list <= OMP_LIST_LASTPRIVATE; list++)
734 for (n = omp_clauses->lists[list]; n; n = n->next)
735 if (n->sym->mark)
736 {
737 gfc_error ("Symbol '%s' present on multiple clauses at %L",
738 n->sym->name, &code->loc);
739 n->sym->mark = 0;
740 }
741
742 for (n = omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; n; n = n->next)
743 if (n->sym->mark)
744 gfc_error ("Symbol '%s' present on multiple clauses at %L",
745 n->sym->name, &code->loc);
746 else
747 n->sym->mark = 1;
748
749 for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next)
750 n->sym->mark = 0;
751
752 for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next)
753 if (n->sym->mark)
754 gfc_error ("Symbol '%s' present on multiple clauses at %L",
755 n->sym->name, &code->loc);
756 else
757 n->sym->mark = 1;
758
759 for (list = 0; list < OMP_LIST_NUM; list++)
760 if ((n = omp_clauses->lists[list]) != NULL)
761 {
762 const char *name;
763
764 if (list < OMP_LIST_REDUCTION_FIRST)
765 name = clause_names[list];
766 else if (list <= OMP_LIST_REDUCTION_LAST)
767 name = clause_names[OMP_LIST_REDUCTION_FIRST];
768 else
769 gcc_unreachable ();
770
771 switch (list)
772 {
773 case OMP_LIST_COPYIN:
774 for (; n != NULL; n = n->next)
775 {
776 if (!n->sym->attr.threadprivate)
777 gfc_error ("Non-THREADPRIVATE object '%s' in COPYIN clause"
778 " at %L", n->sym->name, &code->loc);
779 if (n->sym->attr.allocatable)
780 gfc_error ("COPYIN clause object '%s' is ALLOCATABLE at %L",
781 n->sym->name, &code->loc);
782 }
783 break;
784 case OMP_LIST_COPYPRIVATE:
785 for (; n != NULL; n = n->next)
786 {
787 if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
788 gfc_error ("Assumed size array '%s' in COPYPRIVATE clause "
789 "at %L", n->sym->name, &code->loc);
790 if (n->sym->attr.allocatable)
791 gfc_error ("COPYPRIVATE clause object '%s' is ALLOCATABLE "
792 "at %L", n->sym->name, &code->loc);
793 }
794 break;
795 case OMP_LIST_SHARED:
796 for (; n != NULL; n = n->next)
797 {
798 if (n->sym->attr.threadprivate)
799 gfc_error ("THREADPRIVATE object '%s' in SHARED clause at "
800 "%L", n->sym->name, &code->loc);
801 if (n->sym->attr.cray_pointee)
802 gfc_error ("Cray pointee '%s' in SHARED clause at %L",
803 n->sym->name, &code->loc);
804 }
805 break;
806 default:
807 for (; n != NULL; n = n->next)
808 {
809 if (n->sym->attr.threadprivate)
810 gfc_error ("THREADPRIVATE object '%s' in %s clause at %L",
811 n->sym->name, name, &code->loc);
812 if (n->sym->attr.cray_pointee)
813 gfc_error ("Cray pointee '%s' in %s clause at %L",
814 n->sym->name, name, &code->loc);
815 if (list != OMP_LIST_PRIVATE)
816 {
817 if (n->sym->attr.pointer)
818 gfc_error ("POINTER object '%s' in %s clause at %L",
819 n->sym->name, name, &code->loc);
820 if (n->sym->attr.allocatable)
821 gfc_error ("%s clause object '%s' is ALLOCATABLE at %L",
822 name, n->sym->name, &code->loc);
823 if (n->sym->attr.cray_pointer)
824 gfc_error ("Cray pointer '%s' in %s clause at %L",
825 n->sym->name, name, &code->loc);
826 }
827 if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
828 gfc_error ("Assumed size array '%s' in %s clause at %L",
829 n->sym->name, name, &code->loc);
830 if (n->sym->attr.in_namelist
831 && (list < OMP_LIST_REDUCTION_FIRST
832 || list > OMP_LIST_REDUCTION_LAST))
833 gfc_error ("Variable '%s' in %s clause is used in "
834 "NAMELIST statement at %L",
835 n->sym->name, name, &code->loc);
836 switch (list)
837 {
838 case OMP_LIST_PLUS:
839 case OMP_LIST_MULT:
840 case OMP_LIST_SUB:
841 if (!gfc_numeric_ts (&n->sym->ts))
842 gfc_error ("%c REDUCTION variable '%s' is %s at %L",
843 list == OMP_LIST_PLUS ? '+'
844 : list == OMP_LIST_MULT ? '*' : '-',
845 n->sym->name, gfc_typename (&n->sym->ts),
846 &code->loc);
847 break;
848 case OMP_LIST_AND:
849 case OMP_LIST_OR:
850 case OMP_LIST_EQV:
851 case OMP_LIST_NEQV:
852 if (n->sym->ts.type != BT_LOGICAL)
853 gfc_error ("%s REDUCTION variable '%s' must be LOGICAL "
854 "at %L",
855 list == OMP_LIST_AND ? ".AND."
856 : list == OMP_LIST_OR ? ".OR."
857 : list == OMP_LIST_EQV ? ".EQV." : ".NEQV.",
858 n->sym->name, &code->loc);
859 break;
860 case OMP_LIST_MAX:
861 case OMP_LIST_MIN:
862 if (n->sym->ts.type != BT_INTEGER
863 && n->sym->ts.type != BT_REAL)
864 gfc_error ("%s REDUCTION variable '%s' must be "
865 "INTEGER or REAL at %L",
866 list == OMP_LIST_MAX ? "MAX" : "MIN",
867 n->sym->name, &code->loc);
868 break;
869 case OMP_LIST_IAND:
870 case OMP_LIST_IOR:
871 case OMP_LIST_IEOR:
872 if (n->sym->ts.type != BT_INTEGER)
873 gfc_error ("%s REDUCTION variable '%s' must be INTEGER "
874 "at %L",
875 list == OMP_LIST_IAND ? "IAND"
876 : list == OMP_LIST_MULT ? "IOR" : "IEOR",
877 n->sym->name, &code->loc);
878 break;
879 /* Workaround for PR middle-end/26316, nothing really needs
880 to be done here for OMP_LIST_PRIVATE. */
881 case OMP_LIST_PRIVATE:
882 gcc_assert (code->op != EXEC_NOP);
883 default:
884 break;
885 }
886 }
887 break;
888 }
889 }
890 }
891
892
893 /* Return true if SYM is ever referenced in EXPR except in the SE node. */
894
895 static bool
896 expr_references_sym (gfc_expr *e, gfc_symbol *s, gfc_expr *se)
897 {
898 gfc_actual_arglist *arg;
899 if (e == NULL || e == se)
900 return false;
901 switch (e->expr_type)
902 {
903 case EXPR_CONSTANT:
904 case EXPR_NULL:
905 case EXPR_VARIABLE:
906 case EXPR_STRUCTURE:
907 case EXPR_ARRAY:
908 if (e->symtree != NULL
909 && e->symtree->n.sym == s)
910 return true;
911 return false;
912 case EXPR_SUBSTRING:
913 if (e->ref != NULL
914 && (expr_references_sym (e->ref->u.ss.start, s, se)
915 || expr_references_sym (e->ref->u.ss.end, s, se)))
916 return true;
917 return false;
918 case EXPR_OP:
919 if (expr_references_sym (e->value.op.op2, s, se))
920 return true;
921 return expr_references_sym (e->value.op.op1, s, se);
922 case EXPR_FUNCTION:
923 for (arg = e->value.function.actual; arg; arg = arg->next)
924 if (expr_references_sym (arg->expr, s, se))
925 return true;
926 return false;
927 default:
928 gcc_unreachable ();
929 }
930 }
931
932
933 /* If EXPR is a conversion function that widens the type
934 if WIDENING is true or narrows the type if WIDENING is false,
935 return the inner expression, otherwise return NULL. */
936
937 static gfc_expr *
938 is_conversion (gfc_expr *expr, bool widening)
939 {
940 gfc_typespec *ts1, *ts2;
941
942 if (expr->expr_type != EXPR_FUNCTION
943 || expr->value.function.isym == NULL
944 || expr->value.function.esym != NULL
945 || expr->value.function.isym->generic_id != GFC_ISYM_CONVERSION)
946 return NULL;
947
948 if (widening)
949 {
950 ts1 = &expr->ts;
951 ts2 = &expr->value.function.actual->expr->ts;
952 }
953 else
954 {
955 ts1 = &expr->value.function.actual->expr->ts;
956 ts2 = &expr->ts;
957 }
958
959 if (ts1->type > ts2->type
960 || (ts1->type == ts2->type && ts1->kind > ts2->kind))
961 return expr->value.function.actual->expr;
962
963 return NULL;
964 }
965
966
967 static void
968 resolve_omp_atomic (gfc_code *code)
969 {
970 gfc_symbol *var;
971 gfc_expr *expr2;
972
973 code = code->block->next;
974 gcc_assert (code->op == EXEC_ASSIGN);
975 gcc_assert (code->next == NULL);
976
977 if (code->expr->expr_type != EXPR_VARIABLE
978 || code->expr->symtree == NULL
979 || code->expr->rank != 0
980 || (code->expr->ts.type != BT_INTEGER
981 && code->expr->ts.type != BT_REAL
982 && code->expr->ts.type != BT_COMPLEX
983 && code->expr->ts.type != BT_LOGICAL))
984 {
985 gfc_error ("!$OMP ATOMIC statement must set a scalar variable of "
986 "intrinsic type at %L", &code->loc);
987 return;
988 }
989
990 var = code->expr->symtree->n.sym;
991 expr2 = is_conversion (code->expr2, false);
992 if (expr2 == NULL)
993 expr2 = code->expr2;
994
995 if (expr2->expr_type == EXPR_OP)
996 {
997 gfc_expr *v = NULL, *e, *c;
998 gfc_intrinsic_op op = expr2->value.op.operator;
999 gfc_intrinsic_op alt_op = INTRINSIC_NONE;
1000
1001 switch (op)
1002 {
1003 case INTRINSIC_PLUS:
1004 alt_op = INTRINSIC_MINUS;
1005 break;
1006 case INTRINSIC_TIMES:
1007 alt_op = INTRINSIC_DIVIDE;
1008 break;
1009 case INTRINSIC_MINUS:
1010 alt_op = INTRINSIC_PLUS;
1011 break;
1012 case INTRINSIC_DIVIDE:
1013 alt_op = INTRINSIC_TIMES;
1014 break;
1015 case INTRINSIC_AND:
1016 case INTRINSIC_OR:
1017 break;
1018 case INTRINSIC_EQV:
1019 alt_op = INTRINSIC_NEQV;
1020 break;
1021 case INTRINSIC_NEQV:
1022 alt_op = INTRINSIC_EQV;
1023 break;
1024 default:
1025 gfc_error ("!$OMP ATOMIC assignment operator must be "
1026 "+, *, -, /, .AND., .OR., .EQV. or .NEQV. at %L",
1027 &expr2->where);
1028 return;
1029 }
1030
1031 /* Check for var = var op expr resp. var = expr op var where
1032 expr doesn't reference var and var op expr is mathematically
1033 equivalent to var op (expr) resp. expr op var equivalent to
1034 (expr) op var. We rely here on the fact that the matcher
1035 for x op1 y op2 z where op1 and op2 have equal precedence
1036 returns (x op1 y) op2 z. */
1037 e = expr2->value.op.op2;
1038 if (e->expr_type == EXPR_VARIABLE
1039 && e->symtree != NULL
1040 && e->symtree->n.sym == var)
1041 v = e;
1042 else if ((c = is_conversion (e, true)) != NULL
1043 && c->expr_type == EXPR_VARIABLE
1044 && c->symtree != NULL
1045 && c->symtree->n.sym == var)
1046 v = c;
1047 else
1048 {
1049 gfc_expr **p = NULL, **q;
1050 for (q = &expr2->value.op.op1; (e = *q) != NULL; )
1051 if (e->expr_type == EXPR_VARIABLE
1052 && e->symtree != NULL
1053 && e->symtree->n.sym == var)
1054 {
1055 v = e;
1056 break;
1057 }
1058 else if ((c = is_conversion (e, true)) != NULL)
1059 q = &e->value.function.actual->expr;
1060 else if (e->expr_type != EXPR_OP
1061 || (e->value.op.operator != op
1062 && e->value.op.operator != alt_op)
1063 || e->rank != 0)
1064 break;
1065 else
1066 {
1067 p = q;
1068 q = &e->value.op.op1;
1069 }
1070
1071 if (v == NULL)
1072 {
1073 gfc_error ("!$OMP ATOMIC assignment must be var = var op expr "
1074 "or var = expr op var at %L", &expr2->where);
1075 return;
1076 }
1077
1078 if (p != NULL)
1079 {
1080 e = *p;
1081 switch (e->value.op.operator)
1082 {
1083 case INTRINSIC_MINUS:
1084 case INTRINSIC_DIVIDE:
1085 case INTRINSIC_EQV:
1086 case INTRINSIC_NEQV:
1087 gfc_error ("!$OMP ATOMIC var = var op expr not "
1088 "mathematically equivalent to var = var op "
1089 "(expr) at %L", &expr2->where);
1090 break;
1091 default:
1092 break;
1093 }
1094
1095 /* Canonicalize into var = var op (expr). */
1096 *p = e->value.op.op2;
1097 e->value.op.op2 = expr2;
1098 e->ts = expr2->ts;
1099 if (code->expr2 == expr2)
1100 code->expr2 = expr2 = e;
1101 else
1102 code->expr2->value.function.actual->expr = expr2 = e;
1103
1104 if (!gfc_compare_types (&expr2->value.op.op1->ts, &expr2->ts))
1105 {
1106 for (p = &expr2->value.op.op1; *p != v;
1107 p = &(*p)->value.function.actual->expr)
1108 ;
1109 *p = NULL;
1110 gfc_free_expr (expr2->value.op.op1);
1111 expr2->value.op.op1 = v;
1112 gfc_convert_type (v, &expr2->ts, 2);
1113 }
1114 }
1115 }
1116
1117 if (e->rank != 0 || expr_references_sym (code->expr2, var, v))
1118 {
1119 gfc_error ("expr in !$OMP ATOMIC assignment var = var op expr "
1120 "must be scalar and cannot reference var at %L",
1121 &expr2->where);
1122 return;
1123 }
1124 }
1125 else if (expr2->expr_type == EXPR_FUNCTION
1126 && expr2->value.function.isym != NULL
1127 && expr2->value.function.esym == NULL
1128 && expr2->value.function.actual != NULL
1129 && expr2->value.function.actual->next != NULL)
1130 {
1131 gfc_actual_arglist *arg, *var_arg;
1132
1133 switch (expr2->value.function.isym->generic_id)
1134 {
1135 case GFC_ISYM_MIN:
1136 case GFC_ISYM_MAX:
1137 break;
1138 case GFC_ISYM_IAND:
1139 case GFC_ISYM_IOR:
1140 case GFC_ISYM_IEOR:
1141 if (expr2->value.function.actual->next->next != NULL)
1142 {
1143 gfc_error ("!$OMP ATOMIC assignment intrinsic IAND, IOR "
1144 "or IEOR must have two arguments at %L",
1145 &expr2->where);
1146 return;
1147 }
1148 break;
1149 default:
1150 gfc_error ("!$OMP ATOMIC assignment intrinsic must be "
1151 "MIN, MAX, IAND, IOR or IEOR at %L",
1152 &expr2->where);
1153 return;
1154 }
1155
1156 var_arg = NULL;
1157 for (arg = expr2->value.function.actual; arg; arg = arg->next)
1158 {
1159 if ((arg == expr2->value.function.actual
1160 || (var_arg == NULL && arg->next == NULL))
1161 && arg->expr->expr_type == EXPR_VARIABLE
1162 && arg->expr->symtree != NULL
1163 && arg->expr->symtree->n.sym == var)
1164 var_arg = arg;
1165 else if (expr_references_sym (arg->expr, var, NULL))
1166 gfc_error ("!$OMP ATOMIC intrinsic arguments except one must not "
1167 "reference '%s' at %L", var->name, &arg->expr->where);
1168 if (arg->expr->rank != 0)
1169 gfc_error ("!$OMP ATOMIC intrinsic arguments must be scalar "
1170 "at %L", &arg->expr->where);
1171 }
1172
1173 if (var_arg == NULL)
1174 {
1175 gfc_error ("First or last !$OMP ATOMIC intrinsic argument must "
1176 "be '%s' at %L", var->name, &expr2->where);
1177 return;
1178 }
1179
1180 if (var_arg != expr2->value.function.actual)
1181 {
1182 /* Canonicalize, so that var comes first. */
1183 gcc_assert (var_arg->next == NULL);
1184 for (arg = expr2->value.function.actual;
1185 arg->next != var_arg; arg = arg->next)
1186 ;
1187 var_arg->next = expr2->value.function.actual;
1188 expr2->value.function.actual = var_arg;
1189 arg->next = NULL;
1190 }
1191 }
1192 else
1193 gfc_error ("!$OMP ATOMIC assignment must have an operator or intrinsic "
1194 "on right hand side at %L", &expr2->where);
1195 }
1196
1197
1198 struct omp_context
1199 {
1200 gfc_code *code;
1201 struct pointer_set_t *sharing_clauses;
1202 struct pointer_set_t *private_iterators;
1203 struct omp_context *previous;
1204 } *omp_current_ctx;
1205 gfc_code *omp_current_do_code;
1206
1207
1208 void
1209 gfc_resolve_omp_do_blocks (gfc_code *code, gfc_namespace *ns)
1210 {
1211 if (code->block->next && code->block->next->op == EXEC_DO)
1212 omp_current_do_code = code->block->next;
1213 gfc_resolve_blocks (code->block, ns);
1214 }
1215
1216
1217 void
1218 gfc_resolve_omp_parallel_blocks (gfc_code *code, gfc_namespace *ns)
1219 {
1220 struct omp_context ctx;
1221 gfc_omp_clauses *omp_clauses = code->ext.omp_clauses;
1222 gfc_namelist *n;
1223 int list;
1224
1225 ctx.code = code;
1226 ctx.sharing_clauses = pointer_set_create ();
1227 ctx.private_iterators = pointer_set_create ();
1228 ctx.previous = omp_current_ctx;
1229 omp_current_ctx = &ctx;
1230
1231 for (list = 0; list < OMP_LIST_NUM; list++)
1232 for (n = omp_clauses->lists[list]; n; n = n->next)
1233 pointer_set_insert (ctx.sharing_clauses, n->sym);
1234
1235 if (code->op == EXEC_OMP_PARALLEL_DO)
1236 gfc_resolve_omp_do_blocks (code, ns);
1237 else
1238 gfc_resolve_blocks (code->block, ns);
1239
1240 omp_current_ctx = ctx.previous;
1241 pointer_set_destroy (ctx.sharing_clauses);
1242 pointer_set_destroy (ctx.private_iterators);
1243 }
1244
1245
1246 /* Note a DO iterator variable. This is special in !$omp parallel
1247 construct, where they are predetermined private. */
1248
1249 void
1250 gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym)
1251 {
1252 struct omp_context *ctx;
1253
1254 if (sym->attr.threadprivate)
1255 return;
1256
1257 /* !$omp do and !$omp parallel do iteration variable is predetermined
1258 private just in the !$omp do resp. !$omp parallel do construct,
1259 with no implications for the outer parallel constructs. */
1260 if (code == omp_current_do_code)
1261 return;
1262
1263 for (ctx = omp_current_ctx; ctx; ctx = ctx->previous)
1264 {
1265 if (pointer_set_contains (ctx->sharing_clauses, sym))
1266 continue;
1267
1268 if (! pointer_set_insert (ctx->private_iterators, sym))
1269 {
1270 gfc_omp_clauses *omp_clauses = ctx->code->ext.omp_clauses;
1271 gfc_namelist *p;
1272
1273 p = gfc_get_namelist ();
1274 p->sym = sym;
1275 p->next = omp_clauses->lists[OMP_LIST_PRIVATE];
1276 omp_clauses->lists[OMP_LIST_PRIVATE] = p;
1277 }
1278 }
1279 }
1280
1281
1282 static void
1283 resolve_omp_do (gfc_code *code)
1284 {
1285 gfc_code *do_code;
1286 int list;
1287 gfc_namelist *n;
1288 gfc_symbol *dovar;
1289
1290 if (code->ext.omp_clauses)
1291 resolve_omp_clauses (code);
1292
1293 do_code = code->block->next;
1294 if (do_code->op == EXEC_DO_WHILE)
1295 gfc_error ("!$OMP DO cannot be a DO WHILE or DO without loop control "
1296 "at %L", &do_code->loc);
1297 else
1298 {
1299 gcc_assert (do_code->op == EXEC_DO);
1300 if (do_code->ext.iterator->var->ts.type != BT_INTEGER)
1301 gfc_error ("!$OMP DO iteration variable must be of type integer at %L",
1302 &do_code->loc);
1303 dovar = do_code->ext.iterator->var->symtree->n.sym;
1304 if (dovar->attr.threadprivate)
1305 gfc_error ("!$OMP DO iteration variable must not be THREADPRIVATE "
1306 "at %L", &do_code->loc);
1307 if (code->ext.omp_clauses)
1308 for (list = 0; list < OMP_LIST_NUM; list++)
1309 if (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE)
1310 for (n = code->ext.omp_clauses->lists[list]; n; n = n->next)
1311 if (dovar == n->sym)
1312 {
1313 gfc_error ("!$OMP DO iteration variable present on clause "
1314 "other than PRIVATE or LASTPRIVATE at %L",
1315 &do_code->loc);
1316 break;
1317 }
1318 }
1319 }
1320
1321
1322 /* Resolve OpenMP directive clauses and check various requirements
1323 of each directive. */
1324
1325 void
1326 gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
1327 {
1328 switch (code->op)
1329 {
1330 case EXEC_OMP_DO:
1331 case EXEC_OMP_PARALLEL_DO:
1332 resolve_omp_do (code);
1333 break;
1334 case EXEC_OMP_WORKSHARE:
1335 case EXEC_OMP_PARALLEL_WORKSHARE:
1336 case EXEC_OMP_PARALLEL:
1337 case EXEC_OMP_PARALLEL_SECTIONS:
1338 case EXEC_OMP_SECTIONS:
1339 case EXEC_OMP_SINGLE:
1340 if (code->ext.omp_clauses)
1341 resolve_omp_clauses (code);
1342 break;
1343 case EXEC_OMP_ATOMIC:
1344 resolve_omp_atomic (code);
1345 break;
1346 default:
1347 break;
1348 }
1349 }
Mirror of the offical gcc git repository hosted at gcc.gnu.org