?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Revert emutls patch.
[official-gcc.git] / gcc / fortran / openmp.c
blob09ec255974cc8f787fbdbe60964427264bed39ae
1 /* OpenMP directive matching and resolving.
2 Copyright (C) 2005, 2006 Free Software Foundation, Inc.
3 Contributed by Jakub Jelinek
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 2, 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 COPYING. If not, write to the Free
19 Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
20 02110-1301, USA. */
21
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 match
414 gfc_match_omp_critical (void)
415 {
416 char n[GFC_MAX_SYMBOL_LEN+1];
417
418 if (gfc_match (" ( %n )", n) != MATCH_YES)
419 n[0] = '\0';
420 if (gfc_match_omp_eos () != MATCH_YES)
421 return MATCH_ERROR;
422 new_st.op = EXEC_OMP_CRITICAL;
423 new_st.ext.omp_name = n[0] ? xstrdup (n) : NULL;
424 return MATCH_YES;
425 }
426
427 match
428 gfc_match_omp_do (void)
429 {
430 gfc_omp_clauses *c;
431 if (gfc_match_omp_clauses (&c, OMP_DO_CLAUSES) != MATCH_YES)
432 return MATCH_ERROR;
433 new_st.op = EXEC_OMP_DO;
434 new_st.ext.omp_clauses = c;
435 return MATCH_YES;
436 }
437
438 match
439 gfc_match_omp_flush (void)
440 {
441 gfc_namelist *list = NULL;
442 gfc_match_omp_variable_list (" (", &list, true);
443 if (gfc_match_omp_eos () != MATCH_YES)
444 {
445 gfc_free_namelist (list);
446 return MATCH_ERROR;
447 }
448 new_st.op = EXEC_OMP_FLUSH;
449 new_st.ext.omp_namelist = list;
450 return MATCH_YES;
451 }
452
453 match
454 gfc_match_omp_threadprivate (void)
455 {
456 locus old_loc;
457 char n[GFC_MAX_SYMBOL_LEN+1];
458 gfc_symbol *sym;
459 match m;
460 gfc_symtree *st;
461
462 old_loc = gfc_current_locus;
463
464 m = gfc_match (" (");
465 if (m != MATCH_YES)
466 return m;
467
468 if (!targetm.have_tls)
469 {
470 sorry ("threadprivate variables not supported in this target");
471 goto cleanup;
472 }
473
474 for (;;)
475 {
476 m = gfc_match_symbol (&sym, 0);
477 switch (m)
478 {
479 case MATCH_YES:
480 if (sym->attr.in_common)
481 gfc_error_now ("Threadprivate variable at %C is an element of"
482 " a COMMON block");
483 else if (gfc_add_threadprivate (&sym->attr, sym->name,
484 &sym->declared_at) == FAILURE)
485 goto cleanup;
486 goto next_item;
487 case MATCH_NO:
488 break;
489 case MATCH_ERROR:
490 goto cleanup;
491 }
492
493 m = gfc_match (" / %n /", n);
494 if (m == MATCH_ERROR)
495 goto cleanup;
496 if (m == MATCH_NO || n[0] == '\0')
497 goto syntax;
498
499 st = gfc_find_symtree (gfc_current_ns->common_root, n);
500 if (st == NULL)
501 {
502 gfc_error ("COMMON block /%s/ not found at %C", n);
503 goto cleanup;
504 }
505 st->n.common->threadprivate = 1;
506 for (sym = st->n.common->head; sym; sym = sym->common_next)
507 if (gfc_add_threadprivate (&sym->attr, sym->name,
508 &sym->declared_at) == FAILURE)
509 goto cleanup;
510
511 next_item:
512 if (gfc_match_char (')') == MATCH_YES)
513 break;
514 if (gfc_match_char (',') != MATCH_YES)
515 goto syntax;
516 }
517
518 return MATCH_YES;
519
520 syntax:
521 gfc_error ("Syntax error in !$OMP THREADPRIVATE list at %C");
522
523 cleanup:
524 gfc_current_locus = old_loc;
525 return MATCH_ERROR;
526 }
527
528 match
529 gfc_match_omp_parallel_do (void)
530 {
531 gfc_omp_clauses *c;
532 if (gfc_match_omp_clauses (&c, OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES)
533 != MATCH_YES)
534 return MATCH_ERROR;
535 new_st.op = EXEC_OMP_PARALLEL_DO;
536 new_st.ext.omp_clauses = c;
537 return MATCH_YES;
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 match
553 gfc_match_omp_parallel_workshare (void)
554 {
555 gfc_omp_clauses *c;
556 if (gfc_match_omp_clauses (&c, OMP_PARALLEL_CLAUSES) != MATCH_YES)
557 return MATCH_ERROR;
558 new_st.op = EXEC_OMP_PARALLEL_WORKSHARE;
559 new_st.ext.omp_clauses = c;
560 return MATCH_YES;
561 }
562
563 match
564 gfc_match_omp_sections (void)
565 {
566 gfc_omp_clauses *c;
567 if (gfc_match_omp_clauses (&c, OMP_SECTIONS_CLAUSES) != MATCH_YES)
568 return MATCH_ERROR;
569 new_st.op = EXEC_OMP_SECTIONS;
570 new_st.ext.omp_clauses = c;
571 return MATCH_YES;
572 }
573
574 match
575 gfc_match_omp_single (void)
576 {
577 gfc_omp_clauses *c;
578 if (gfc_match_omp_clauses (&c, OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE)
579 != MATCH_YES)
580 return MATCH_ERROR;
581 new_st.op = EXEC_OMP_SINGLE;
582 new_st.ext.omp_clauses = c;
583 return MATCH_YES;
584 }
585
586 match
587 gfc_match_omp_workshare (void)
588 {
589 if (gfc_match_omp_eos () != MATCH_YES)
590 return MATCH_ERROR;
591 new_st.op = EXEC_OMP_WORKSHARE;
592 new_st.ext.omp_clauses = gfc_get_omp_clauses ();
593 return MATCH_YES;
594 }
595
596 match
597 gfc_match_omp_master (void)
598 {
599 if (gfc_match_omp_eos () != MATCH_YES)
600 return MATCH_ERROR;
601 new_st.op = EXEC_OMP_MASTER;
602 new_st.ext.omp_clauses = NULL;
603 return MATCH_YES;
604 }
605
606 match
607 gfc_match_omp_ordered (void)
608 {
609 if (gfc_match_omp_eos () != MATCH_YES)
610 return MATCH_ERROR;
611 new_st.op = EXEC_OMP_ORDERED;
612 new_st.ext.omp_clauses = NULL;
613 return MATCH_YES;
614 }
615
616 match
617 gfc_match_omp_atomic (void)
618 {
619 if (gfc_match_omp_eos () != MATCH_YES)
620 return MATCH_ERROR;
621 new_st.op = EXEC_OMP_ATOMIC;
622 new_st.ext.omp_clauses = NULL;
623 return MATCH_YES;
624 }
625
626 match
627 gfc_match_omp_barrier (void)
628 {
629 if (gfc_match_omp_eos () != MATCH_YES)
630 return MATCH_ERROR;
631 new_st.op = EXEC_OMP_BARRIER;
632 new_st.ext.omp_clauses = NULL;
633 return MATCH_YES;
634 }
635
636 match
637 gfc_match_omp_end_nowait (void)
638 {
639 bool nowait = false;
640 if (gfc_match ("% nowait") == MATCH_YES)
641 nowait = true;
642 if (gfc_match_omp_eos () != MATCH_YES)
643 return MATCH_ERROR;
644 new_st.op = EXEC_OMP_END_NOWAIT;
645 new_st.ext.omp_bool = nowait;
646 return MATCH_YES;
647 }
648
649 match
650 gfc_match_omp_end_single (void)
651 {
652 gfc_omp_clauses *c;
653 if (gfc_match ("% nowait") == MATCH_YES)
654 {
655 new_st.op = EXEC_OMP_END_NOWAIT;
656 new_st.ext.omp_bool = true;
657 return MATCH_YES;
658 }
659 if (gfc_match_omp_clauses (&c, OMP_CLAUSE_COPYPRIVATE) != MATCH_YES)
660 return MATCH_ERROR;
661 new_st.op = EXEC_OMP_END_SINGLE;
662 new_st.ext.omp_clauses = c;
663 return MATCH_YES;
664 }
665
666 /* OpenMP directive resolving routines. */
667
668 static void
669 resolve_omp_clauses (gfc_code *code)
670 {
671 gfc_omp_clauses *omp_clauses = code->ext.omp_clauses;
672 gfc_namelist *n;
673 int list;
674 static const char *clause_names[]
675 = { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED",
676 "COPYIN", "REDUCTION" };
677
678 if (omp_clauses == NULL)
679 return;
680
681 if (omp_clauses->if_expr)
682 {
683 gfc_expr *expr = omp_clauses->if_expr;
684 if (gfc_resolve_expr (expr) == FAILURE
685 || expr->ts.type != BT_LOGICAL || expr->rank != 0)
686 gfc_error ("IF clause at %L requires a scalar LOGICAL expression",
687 &expr->where);
688 }
689 if (omp_clauses->num_threads)
690 {
691 gfc_expr *expr = omp_clauses->num_threads;
692 if (gfc_resolve_expr (expr) == FAILURE
693 || expr->ts.type != BT_INTEGER || expr->rank != 0)
694 gfc_error ("NUM_THREADS clause at %L requires a scalar"
695 " INTEGER expression", &expr->where);
696 }
697 if (omp_clauses->chunk_size)
698 {
699 gfc_expr *expr = omp_clauses->chunk_size;
700 if (gfc_resolve_expr (expr) == FAILURE
701 || expr->ts.type != BT_INTEGER || expr->rank != 0)
702 gfc_error ("SCHEDULE clause's chunk_size at %L requires"
703 " a scalar INTEGER expression", &expr->where);
704 }
705
706 /* Check that no symbol appears on multiple clauses, except that
707 a symbol can appear on both firstprivate and lastprivate. */
708 for (list = 0; list < OMP_LIST_NUM; list++)
709 for (n = omp_clauses->lists[list]; n; n = n->next)
710 n->sym->mark = 0;
711
712 for (list = 0; list < OMP_LIST_NUM; list++)
713 if (list != OMP_LIST_FIRSTPRIVATE && list != OMP_LIST_LASTPRIVATE)
714 for (n = omp_clauses->lists[list]; n; n = n->next)
715 if (n->sym->mark)
716 gfc_error ("Symbol '%s' present on multiple clauses at %L",
717 n->sym->name, &code->loc);
718 else
719 n->sym->mark = 1;
720
721 gcc_assert (OMP_LIST_LASTPRIVATE == OMP_LIST_FIRSTPRIVATE + 1);
722 for (list = OMP_LIST_FIRSTPRIVATE; list <= OMP_LIST_LASTPRIVATE; list++)
723 for (n = omp_clauses->lists[list]; n; n = n->next)
724 if (n->sym->mark)
725 {
726 gfc_error ("Symbol '%s' present on multiple clauses at %L",
727 n->sym->name, &code->loc);
728 n->sym->mark = 0;
729 }
730
731 for (n = omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; n; n = n->next)
732 if (n->sym->mark)
733 gfc_error ("Symbol '%s' present on multiple clauses at %L",
734 n->sym->name, &code->loc);
735 else
736 n->sym->mark = 1;
737
738 for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next)
739 n->sym->mark = 0;
740
741 for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next)
742 if (n->sym->mark)
743 gfc_error ("Symbol '%s' present on multiple clauses at %L",
744 n->sym->name, &code->loc);
745 else
746 n->sym->mark = 1;
747
748 for (list = 0; list < OMP_LIST_NUM; list++)
749 if ((n = omp_clauses->lists[list]) != NULL)
750 {
751 const char *name;
752
753 if (list < OMP_LIST_REDUCTION_FIRST)
754 name = clause_names[list];
755 else if (list <= OMP_LIST_REDUCTION_LAST)
756 name = clause_names[OMP_LIST_REDUCTION_FIRST];
757 else
758 gcc_unreachable ();
759
760 switch (list)
761 {
762 case OMP_LIST_COPYIN:
763 for (; n != NULL; n = n->next)
764 {
765 if (!n->sym->attr.threadprivate)
766 gfc_error ("Non-THREADPRIVATE object '%s' in COPYIN clause"
767 " at %L", n->sym->name, &code->loc);
768 if (n->sym->attr.allocatable)
769 gfc_error ("COPYIN clause object '%s' is ALLOCATABLE at %L",
770 n->sym->name, &code->loc);
771 }
772 break;
773 case OMP_LIST_COPYPRIVATE:
774 for (; n != NULL; n = n->next)
775 {
776 if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
777 gfc_error ("Assumed size array '%s' in COPYPRIVATE clause"
778 " at %L", n->sym->name, &code->loc);
779 if (n->sym->attr.allocatable)
780 gfc_error ("COPYPRIVATE clause object '%s' is ALLOCATABLE"
781 " at %L", n->sym->name, &code->loc);
782 }
783 break;
784 case OMP_LIST_SHARED:
785 for (; n != NULL; n = n->next)
786 {
787 if (n->sym->attr.threadprivate)
788 gfc_error ("THREADPRIVATE object '%s' in SHARED clause at"
789 " %L", n->sym->name, &code->loc);
790 if (n->sym->attr.cray_pointee)
791 gfc_error ("Cray pointee '%s' in SHARED clause at %L",
792 n->sym->name, &code->loc);
793 }
794 break;
795 default:
796 for (; n != NULL; n = n->next)
797 {
798 if (n->sym->attr.threadprivate)
799 gfc_error ("THREADPRIVATE object '%s' in %s clause at %L",
800 n->sym->name, name, &code->loc);
801 if (n->sym->attr.cray_pointee)
802 gfc_error ("Cray pointee '%s' in %s clause at %L",
803 n->sym->name, name, &code->loc);
804 if (list != OMP_LIST_PRIVATE)
805 {
806 if (n->sym->attr.pointer)
807 gfc_error ("POINTER object '%s' in %s clause at %L",
808 n->sym->name, name, &code->loc);
809 if (n->sym->attr.allocatable)
810 gfc_error ("%s clause object '%s' is ALLOCATABLE at %L",
811 name, n->sym->name, &code->loc);
812 if (n->sym->attr.cray_pointer)
813 gfc_error ("Cray pointer '%s' in %s clause at %L",
814 n->sym->name, name, &code->loc);
815 }
816 if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
817 gfc_error ("Assumed size array '%s' in %s clause at %L",
818 n->sym->name, name, &code->loc);
819 if (n->sym->attr.in_namelist
820 && (list < OMP_LIST_REDUCTION_FIRST
821 || list > OMP_LIST_REDUCTION_LAST))
822 gfc_error ("Variable '%s' in %s clause is used in"
823 " NAMELIST statement at %L",
824 n->sym->name, name, &code->loc);
825 switch (list)
826 {
827 case OMP_LIST_PLUS:
828 case OMP_LIST_MULT:
829 case OMP_LIST_SUB:
830 if (!gfc_numeric_ts (&n->sym->ts))
831 gfc_error ("%c REDUCTION variable '%s' is %s at %L",
832 list == OMP_LIST_PLUS ? '+'
833 : list == OMP_LIST_MULT ? '*' : '-',
834 n->sym->name, gfc_typename (&n->sym->ts),
835 &code->loc);
836 break;
837 case OMP_LIST_AND:
838 case OMP_LIST_OR:
839 case OMP_LIST_EQV:
840 case OMP_LIST_NEQV:
841 if (n->sym->ts.type != BT_LOGICAL)
842 gfc_error ("%s REDUCTION variable '%s' must be LOGICAL"
843 " at %L",
844 list == OMP_LIST_AND ? ".AND."
845 : list == OMP_LIST_OR ? ".OR."
846 : list == OMP_LIST_EQV ? ".EQV." : ".NEQV.",
847 n->sym->name, &code->loc);
848 break;
849 case OMP_LIST_MAX:
850 case OMP_LIST_MIN:
851 if (n->sym->ts.type != BT_INTEGER
852 && n->sym->ts.type != BT_REAL)
853 gfc_error ("%s REDUCTION variable '%s' must be"
854 " INTEGER or REAL at %L",
855 list == OMP_LIST_MAX ? "MAX" : "MIN",
856 n->sym->name, &code->loc);
857 break;
858 case OMP_LIST_IAND:
859 case OMP_LIST_IOR:
860 case OMP_LIST_IEOR:
861 if (n->sym->ts.type != BT_INTEGER)
862 gfc_error ("%s REDUCTION variable '%s' must be INTEGER"
863 " at %L",
864 list == OMP_LIST_IAND ? "IAND"
865 : list == OMP_LIST_MULT ? "IOR" : "IEOR",
866 n->sym->name, &code->loc);
867 break;
868 /* Workaround for PR middle-end/26316, nothing really needs
869 to be done here for OMP_LIST_PRIVATE. */
870 case OMP_LIST_PRIVATE:
871 gcc_assert (code->op != EXEC_NOP);
872 default:
873 break;
874 }
875 }
876 break;
877 }
878 }
879 }
880
881 /* Return true if SYM is ever referenced in EXPR except in the SE node. */
882
883 static bool
884 expr_references_sym (gfc_expr *e, gfc_symbol *s, gfc_expr *se)
885 {
886 gfc_actual_arglist *arg;
887 if (e == NULL || e == se)
888 return false;
889 switch (e->expr_type)
890 {
891 case EXPR_CONSTANT:
892 case EXPR_NULL:
893 case EXPR_VARIABLE:
894 case EXPR_STRUCTURE:
895 case EXPR_ARRAY:
896 if (e->symtree != NULL
897 && e->symtree->n.sym == s)
898 return true;
899 return false;
900 case EXPR_SUBSTRING:
901 if (e->ref != NULL
902 && (expr_references_sym (e->ref->u.ss.start, s, se)
903 || expr_references_sym (e->ref->u.ss.end, s, se)))
904 return true;
905 return false;
906 case EXPR_OP:
907 if (expr_references_sym (e->value.op.op2, s, se))
908 return true;
909 return expr_references_sym (e->value.op.op1, s, se);
910 case EXPR_FUNCTION:
911 for (arg = e->value.function.actual; arg; arg = arg->next)
912 if (expr_references_sym (arg->expr, s, se))
913 return true;
914 return false;
915 default:
916 gcc_unreachable ();
917 }
918 }
919
920 /* If EXPR is a conversion function that widens the type
921 if WIDENING is true or narrows the type if WIDENING is false,
922 return the inner expression, otherwise return NULL. */
923
924 static gfc_expr *
925 is_conversion (gfc_expr *expr, bool widening)
926 {
927 gfc_typespec *ts1, *ts2;
928
929 if (expr->expr_type != EXPR_FUNCTION
930 || expr->value.function.isym == NULL
931 || expr->value.function.esym != NULL
932 || expr->value.function.isym->generic_id != GFC_ISYM_CONVERSION)
933 return NULL;
934
935 if (widening)
936 {
937 ts1 = &expr->ts;
938 ts2 = &expr->value.function.actual->expr->ts;
939 }
940 else
941 {
942 ts1 = &expr->value.function.actual->expr->ts;
943 ts2 = &expr->ts;
944 }
945
946 if (ts1->type > ts2->type
947 || (ts1->type == ts2->type && ts1->kind > ts2->kind))
948 return expr->value.function.actual->expr;
949
950 return NULL;
951 }
952
953 static void
954 resolve_omp_atomic (gfc_code *code)
955 {
956 gfc_symbol *var;
957 gfc_expr *expr2;
958
959 code = code->block->next;
960 gcc_assert (code->op == EXEC_ASSIGN);
961 gcc_assert (code->next == NULL);
962
963 if (code->expr->expr_type != EXPR_VARIABLE
964 || code->expr->symtree == NULL
965 || code->expr->rank != 0
966 || (code->expr->ts.type != BT_INTEGER
967 && code->expr->ts.type != BT_REAL
968 && code->expr->ts.type != BT_COMPLEX
969 && code->expr->ts.type != BT_LOGICAL))
970 {
971 gfc_error ("!$OMP ATOMIC statement must set a scalar variable of"
972 " intrinsic type at %L", &code->loc);
973 return;
974 }
975
976 var = code->expr->symtree->n.sym;
977 expr2 = is_conversion (code->expr2, false);
978 if (expr2 == NULL)
979 expr2 = code->expr2;
980
981 if (expr2->expr_type == EXPR_OP)
982 {
983 gfc_expr *v = NULL, *e, *c;
984 gfc_intrinsic_op op = expr2->value.op.operator;
985 gfc_intrinsic_op alt_op = INTRINSIC_NONE;
986
987 switch (op)
988 {
989 case INTRINSIC_PLUS:
990 alt_op = INTRINSIC_MINUS;
991 break;
992 case INTRINSIC_TIMES:
993 alt_op = INTRINSIC_DIVIDE;
994 break;
995 case INTRINSIC_MINUS:
996 alt_op = INTRINSIC_PLUS;
997 break;
998 case INTRINSIC_DIVIDE:
999 alt_op = INTRINSIC_TIMES;
1000 break;
1001 case INTRINSIC_AND:
1002 case INTRINSIC_OR:
1003 break;
1004 case INTRINSIC_EQV:
1005 alt_op = INTRINSIC_NEQV;
1006 break;
1007 case INTRINSIC_NEQV:
1008 alt_op = INTRINSIC_EQV;
1009 break;
1010 default:
1011 gfc_error ("!$OMP ATOMIC assignment operator must be"
1012 " +, *, -, /, .AND., .OR., .EQV. or .NEQV. at %L",
1013 &expr2->where);
1014 return;
1015 }
1016
1017 /* Check for var = var op expr resp. var = expr op var where
1018 expr doesn't reference var and var op expr is mathematically
1019 equivalent to var op (expr) resp. expr op var equivalent to
1020 (expr) op var. We rely here on the fact that the matcher
1021 for x op1 y op2 z where op1 and op2 have equal precedence
1022 returns (x op1 y) op2 z. */
1023 e = expr2->value.op.op2;
1024 if (e->expr_type == EXPR_VARIABLE
1025 && e->symtree != NULL
1026 && e->symtree->n.sym == var)
1027 v = e;
1028 else if ((c = is_conversion (e, true)) != NULL
1029 && c->expr_type == EXPR_VARIABLE
1030 && c->symtree != NULL
1031 && c->symtree->n.sym == var)
1032 v = c;
1033 else
1034 {
1035 gfc_expr **p = NULL, **q;
1036 for (q = &expr2->value.op.op1; (e = *q) != NULL; )
1037 if (e->expr_type == EXPR_VARIABLE
1038 && e->symtree != NULL
1039 && e->symtree->n.sym == var)
1040 {
1041 v = e;
1042 break;
1043 }
1044 else if ((c = is_conversion (e, true)) != NULL)
1045 q = &e->value.function.actual->expr;
1046 else if (e->expr_type != EXPR_OP
1047 || (e->value.op.operator != op
1048 && e->value.op.operator != alt_op)
1049 || e->rank != 0)
1050 break;
1051 else
1052 {
1053 p = q;
1054 q = &e->value.op.op1;
1055 }
1056
1057 if (v == NULL)
1058 {
1059 gfc_error ("!$OMP ATOMIC assignment must be var = var op expr"
1060 " or var = expr op var at %L", &expr2->where);
1061 return;
1062 }
1063
1064 if (p != NULL)
1065 {
1066 e = *p;
1067 switch (e->value.op.operator)
1068 {
1069 case INTRINSIC_MINUS:
1070 case INTRINSIC_DIVIDE:
1071 case INTRINSIC_EQV:
1072 case INTRINSIC_NEQV:
1073 gfc_error ("!$OMP ATOMIC var = var op expr not"
1074 " mathematically equivalent to var = var op"
1075 " (expr) at %L", &expr2->where);
1076 break;
1077 default:
1078 break;
1079 }
1080
1081 /* Canonicalize into var = var op (expr). */
1082 *p = e->value.op.op2;
1083 e->value.op.op2 = expr2;
1084 e->ts = expr2->ts;
1085 if (code->expr2 == expr2)
1086 code->expr2 = expr2 = e;
1087 else
1088 code->expr2->value.function.actual->expr = expr2 = e;
1089
1090 if (!gfc_compare_types (&expr2->value.op.op1->ts, &expr2->ts))
1091 {
1092 for (p = &expr2->value.op.op1; *p != v;
1093 p = &(*p)->value.function.actual->expr)
1094 ;
1095 *p = NULL;
1096 gfc_free_expr (expr2->value.op.op1);
1097 expr2->value.op.op1 = v;
1098 gfc_convert_type (v, &expr2->ts, 2);
1099 }
1100 }
1101 }
1102
1103 if (e->rank != 0 || expr_references_sym (code->expr2, var, v))
1104 {
1105 gfc_error ("expr in !$OMP ATOMIC assignment var = var op expr"
1106 " must be scalar and cannot reference var at %L",
1107 &expr2->where);
1108 return;
1109 }
1110 }
1111 else if (expr2->expr_type == EXPR_FUNCTION
1112 && expr2->value.function.isym != NULL
1113 && expr2->value.function.esym == NULL
1114 && expr2->value.function.actual != NULL
1115 && expr2->value.function.actual->next != NULL)
1116 {
1117 gfc_actual_arglist *arg, *var_arg;
1118
1119 switch (expr2->value.function.isym->generic_id)
1120 {
1121 case GFC_ISYM_MIN:
1122 case GFC_ISYM_MAX:
1123 break;
1124 case GFC_ISYM_IAND:
1125 case GFC_ISYM_IOR:
1126 case GFC_ISYM_IEOR:
1127 if (expr2->value.function.actual->next->next != NULL)
1128 {
1129 gfc_error ("!$OMP ATOMIC assignment intrinsic IAND, IOR"
1130 "or IEOR must have two arguments at %L",
1131 &expr2->where);
1132 return;
1133 }
1134 break;
1135 default:
1136 gfc_error ("!$OMP ATOMIC assignment intrinsic must be"
1137 " MIN, MAX, IAND, IOR or IEOR at %L",
1138 &expr2->where);
1139 return;
1140 }
1141
1142 var_arg = NULL;
1143 for (arg = expr2->value.function.actual; arg; arg = arg->next)
1144 {
1145 if ((arg == expr2->value.function.actual
1146 || (var_arg == NULL && arg->next == NULL))
1147 && arg->expr->expr_type == EXPR_VARIABLE
1148 && arg->expr->symtree != NULL
1149 && arg->expr->symtree->n.sym == var)
1150 var_arg = arg;
1151 else if (expr_references_sym (arg->expr, var, NULL))
1152 gfc_error ("!$OMP ATOMIC intrinsic arguments except one must not"
1153 " reference '%s' at %L", var->name, &arg->expr->where);
1154 if (arg->expr->rank != 0)
1155 gfc_error ("!$OMP ATOMIC intrinsic arguments must be scalar"
1156 " at %L", &arg->expr->where);
1157 }
1158
1159 if (var_arg == NULL)
1160 {
1161 gfc_error ("First or last !$OMP ATOMIC intrinsic argument must"
1162 " be '%s' at %L", var->name, &expr2->where);
1163 return;
1164 }
1165
1166 if (var_arg != expr2->value.function.actual)
1167 {
1168 /* Canonicalize, so that var comes first. */
1169 gcc_assert (var_arg->next == NULL);
1170 for (arg = expr2->value.function.actual;
1171 arg->next != var_arg; arg = arg->next)
1172 ;
1173 var_arg->next = expr2->value.function.actual;
1174 expr2->value.function.actual = var_arg;
1175 arg->next = NULL;
1176 }
1177 }
1178 else
1179 gfc_error ("!$OMP ATOMIC assignment must have an operator or intrinsic"
1180 " on right hand side at %L", &expr2->where);
1181 }
1182
1183 struct omp_context
1184 {
1185 gfc_code *code;
1186 struct pointer_set_t *sharing_clauses;
1187 struct pointer_set_t *private_iterators;
1188 struct omp_context *previous;
1189 } *omp_current_ctx;
1190 gfc_code *omp_current_do_code;
1191
1192 void
1193 gfc_resolve_omp_do_blocks (gfc_code *code, gfc_namespace *ns)
1194 {
1195 if (code->block->next && code->block->next->op == EXEC_DO)
1196 omp_current_do_code = code->block->next;
1197 gfc_resolve_blocks (code->block, ns);
1198 }
1199
1200 void
1201 gfc_resolve_omp_parallel_blocks (gfc_code *code, gfc_namespace *ns)
1202 {
1203 struct omp_context ctx;
1204 gfc_omp_clauses *omp_clauses = code->ext.omp_clauses;
1205 gfc_namelist *n;
1206 int list;
1207
1208 ctx.code = code;
1209 ctx.sharing_clauses = pointer_set_create ();
1210 ctx.private_iterators = pointer_set_create ();
1211 ctx.previous = omp_current_ctx;
1212 omp_current_ctx = &ctx;
1213
1214 for (list = 0; list < OMP_LIST_NUM; list++)
1215 for (n = omp_clauses->lists[list]; n; n = n->next)
1216 pointer_set_insert (ctx.sharing_clauses, n->sym);
1217
1218 if (code->op == EXEC_OMP_PARALLEL_DO)
1219 gfc_resolve_omp_do_blocks (code, ns);
1220 else
1221 gfc_resolve_blocks (code->block, ns);
1222
1223 omp_current_ctx = ctx.previous;
1224 pointer_set_destroy (ctx.sharing_clauses);
1225 pointer_set_destroy (ctx.private_iterators);
1226 }
1227
1228 /* Note a DO iterator variable. This is special in !$omp parallel
1229 construct, where they are predetermined private. */
1230
1231 void
1232 gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym)
1233 {
1234 struct omp_context *ctx;
1235
1236 if (sym->attr.threadprivate)
1237 return;
1238
1239 /* !$omp do and !$omp parallel do iteration variable is predetermined
1240 private just in the !$omp do resp. !$omp parallel do construct,
1241 with no implications for the outer parallel constructs. */
1242 if (code == omp_current_do_code)
1243 return;
1244
1245 for (ctx = omp_current_ctx; ctx; ctx = ctx->previous)
1246 {
1247 if (pointer_set_contains (ctx->sharing_clauses, sym))
1248 continue;
1249
1250 if (! pointer_set_insert (ctx->private_iterators, sym))
1251 {
1252 gfc_omp_clauses *omp_clauses = ctx->code->ext.omp_clauses;
1253 gfc_namelist *p;
1254
1255 p = gfc_get_namelist ();
1256 p->sym = sym;
1257 p->next = omp_clauses->lists[OMP_LIST_PRIVATE];
1258 omp_clauses->lists[OMP_LIST_PRIVATE] = p;
1259 }
1260 }
1261 }
1262
1263 static void
1264 resolve_omp_do (gfc_code *code)
1265 {
1266 gfc_code *do_code;
1267 int list;
1268 gfc_namelist *n;
1269 gfc_symbol *dovar;
1270
1271 if (code->ext.omp_clauses)
1272 resolve_omp_clauses (code);
1273
1274 do_code = code->block->next;
1275 if (do_code->op == EXEC_DO_WHILE)
1276 gfc_error ("!$OMP DO cannot be a DO WHILE or DO without loop control at %L",
1277 &do_code->loc);
1278 else
1279 {
1280 gcc_assert (do_code->op == EXEC_DO);
1281 if (do_code->ext.iterator->var->ts.type != BT_INTEGER)
1282 gfc_error ("!$OMP DO iteration variable must be of type integer at %L",
1283 &do_code->loc);
1284 dovar = do_code->ext.iterator->var->symtree->n.sym;
1285 if (dovar->attr.threadprivate)
1286 gfc_error ("!$OMP DO iteration variable must not be THREADPRIVATE at %L",
1287 &do_code->loc);
1288 if (code->ext.omp_clauses)
1289 for (list = 0; list < OMP_LIST_NUM; list++)
1290 if (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE)
1291 for (n = code->ext.omp_clauses->lists[list]; n; n = n->next)
1292 if (dovar == n->sym)
1293 {
1294 gfc_error ("!$OMP DO iteration variable present on clause"
1295 " other than PRIVATE or LASTPRIVATE at %L",
1296 &do_code->loc);
1297 break;
1298 }
1299 }
1300 }
1301
1302 /* Resolve OpenMP directive clauses and check various requirements
1303 of each directive. */
1304
1305 void
1306 gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
1307 {
1308 switch (code->op)
1309 {
1310 case EXEC_OMP_DO:
1311 case EXEC_OMP_PARALLEL_DO:
1312 resolve_omp_do (code);
1313 break;
1314 case EXEC_OMP_WORKSHARE:
1315 case EXEC_OMP_PARALLEL_WORKSHARE:
1316 case EXEC_OMP_PARALLEL:
1317 case EXEC_OMP_PARALLEL_SECTIONS:
1318 case EXEC_OMP_SECTIONS:
1319 case EXEC_OMP_SINGLE:
1320 if (code->ext.omp_clauses)
1321 resolve_omp_clauses (code);
1322 break;
1323 case EXEC_OMP_ATOMIC:
1324 resolve_omp_atomic (code);
1325 break;
1326 default:
1327 break;
1328 }
1329 }
Mirror of the offical gcc git repository hosted at gcc.gnu.org