]> git.ipfire.org Git - thirdparty/gcc.git/blame - gcc/fortran/trans-openmp.c
projects / thirdparty / gcc.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Update copyright years.
[thirdparty/gcc.git] / gcc / fortran / trans-openmp.c
CommitLineData
6c7a4dfd 1/* OpenMP directive translation -- generate GCC trees from gfc_code.
818ab71a 2 Copyright (C) 2005-2016 Free Software Foundation, Inc.
6c7a4dfd
JJ		 3 Contributed by Jakub Jelinek <jakub@redhat.com>
4
5This file is part of GCC.
6
7GCC is free software; you can redistribute it and/or modify it under
8the terms of the GNU General Public License as published by the Free
d234d788 9Software Foundation; either version 3, or (at your option) any later
6c7a4dfd
JJ		 10version.
11
12GCC is distributed in the hope that it will be useful, but WITHOUT ANY
13WARRANTY; without even the implied warranty of MERCHANTABILITY or
14FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15for more details.
16
17You should have received a copy of the GNU General Public License
d234d788
NC		 18along with GCC; see the file COPYING3. If not see
19<http://www.gnu.org/licenses/>. */
6c7a4dfd
JJ		 20
21
22#include "config.h"
23#include "system.h"
24#include "coretypes.h"
c7131fb2 25#include "options.h"
2adfab87
AM		 26#include "tree.h"
27#include "gfortran.h"
2fb9a547 28#include "gimple-expr.h"
2adfab87 29#include "trans.h"
d8a2d370 30#include "stringpool.h"
2adfab87
AM		 31#include "fold-const.h"
32#include "gimplify.h" /* For create_tmp_var_raw. */
6c7a4dfd
JJ		 33#include "trans-stmt.h"
34#include "trans-types.h"
35#include "trans-array.h"
36#include "trans-const.h"
37#include "arith.h"
0645c1a2 38#include "omp-low.h"
41dbbb37 39#include "gomp-constants.h"
6c7a4dfd 40
34d01e1d 41int ompws_flags;
6c7a4dfd
JJ		 42
43/* True if OpenMP should privatize what this DECL points to rather
44 than the DECL itself. */
45
46bool
58f9752a 47gfc_omp_privatize_by_reference (const_tree decl)
6c7a4dfd
JJ		 48{
49 tree type = TREE_TYPE (decl);
50
36cefd39
JJ		 51 if (TREE_CODE (type) == REFERENCE_TYPE
52 && (!DECL_ARTIFICIAL (decl) || TREE_CODE (decl) == PARM_DECL))
6c7a4dfd
JJ		 53 return true;
54
55 if (TREE_CODE (type) == POINTER_TYPE)
56 {
e1c82219 57 /* Array POINTER/ALLOCATABLE have aggregate types, all user variables
b46ebd6c
JJ		 58 that have POINTER_TYPE type and aren't scalar pointers, scalar
59 allocatables, Cray pointees or C pointers are supposed to be
60 privatized by reference. */
92d28cbb
JJ		 61 if (GFC_DECL_GET_SCALAR_POINTER (decl)
62 || GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
b46ebd6c
JJ		 63 || GFC_DECL_CRAY_POINTEE (decl)
64 || VOID_TYPE_P (TREE_TYPE (TREE_TYPE (decl))))
e1c82219
JJ		 65 return false;
66
2b45bf21
JJ		 67 if (!DECL_ARTIFICIAL (decl)
68 && TREE_CODE (TREE_TYPE (type)) != FUNCTION_TYPE)
6c7a4dfd
JJ		 69 return true;
70
71 /* Some arrays are expanded as DECL_ARTIFICIAL pointers
72 by the frontend. */
73 if (DECL_LANG_SPECIFIC (decl)
74 && GFC_DECL_SAVED_DESCRIPTOR (decl))
75 return true;
76 }
77
78 return false;
79}
80
81/* True if OpenMP sharing attribute of DECL is predetermined. */
82
83enum omp_clause_default_kind
84gfc_omp_predetermined_sharing (tree decl)
85{
92d28cbb
JJ		 86 /* Associate names preserve the association established during ASSOCIATE.
87 As they are implemented either as pointers to the selector or array
88 descriptor and shouldn't really change in the ASSOCIATE region,
89 this decl can be either shared or firstprivate. If it is a pointer,
90 use firstprivate, as it is cheaper that way, otherwise make it shared. */
91 if (GFC_DECL_ASSOCIATE_VAR_P (decl))
92 {
93 if (TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE)
94 return OMP_CLAUSE_DEFAULT_FIRSTPRIVATE;
95 else
96 return OMP_CLAUSE_DEFAULT_SHARED;
97 }
98
79943d19
JJ		 99 if (DECL_ARTIFICIAL (decl)
100 && ! GFC_DECL_RESULT (decl)
101 && ! (DECL_LANG_SPECIFIC (decl)
102 && GFC_DECL_SAVED_DESCRIPTOR (decl)))
6c7a4dfd
JJ		 103 return OMP_CLAUSE_DEFAULT_SHARED;
104
105 /* Cray pointees shouldn't be listed in any clauses and should be
106 gimplified to dereference of the corresponding Cray pointer.
107 Make them all private, so that they are emitted in the debug
108 information. */
109 if (GFC_DECL_CRAY_POINTEE (decl))
110 return OMP_CLAUSE_DEFAULT_PRIVATE;
111
20906c66 112 /* Assumed-size arrays are predetermined shared. */
a68ab351
JJ		 113 if (TREE_CODE (decl) == PARM_DECL
114 && GFC_ARRAY_TYPE_P (TREE_TYPE (decl))
115 && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (decl)) == GFC_ARRAY_UNKNOWN
116 && GFC_TYPE_ARRAY_UBOUND (TREE_TYPE (decl),
117 GFC_TYPE_ARRAY_RANK (TREE_TYPE (decl)) - 1)
118 == NULL)
119 return OMP_CLAUSE_DEFAULT_SHARED;
120
2b45bf21
JJ		 121 /* Dummy procedures aren't considered variables by OpenMP, thus are
122 disallowed in OpenMP clauses. They are represented as PARM_DECLs
123 in the middle-end, so return OMP_CLAUSE_DEFAULT_FIRSTPRIVATE here
124 to avoid complaining about their uses with default(none). */
125 if (TREE_CODE (decl) == PARM_DECL
126 && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE
127 && TREE_CODE (TREE_TYPE (TREE_TYPE (decl))) == FUNCTION_TYPE)
128 return OMP_CLAUSE_DEFAULT_FIRSTPRIVATE;
129
6c7a4dfd
JJ		 130 /* COMMON and EQUIVALENCE decls are shared. They
131 are only referenced through DECL_VALUE_EXPR of the variables
132 contained in them. If those are privatized, they will not be
133 gimplified to the COMMON or EQUIVALENCE decls. */
134 if (GFC_DECL_COMMON_OR_EQUIV (decl) && ! DECL_HAS_VALUE_EXPR_P (decl))
135 return OMP_CLAUSE_DEFAULT_SHARED;
136
137 if (GFC_DECL_RESULT (decl) && ! DECL_HAS_VALUE_EXPR_P (decl))
138 return OMP_CLAUSE_DEFAULT_SHARED;
139
18cda88d
JJ		 140 /* These are either array or derived parameters, or vtables.
141 In the former cases, the OpenMP standard doesn't consider them to be
142 variables at all (they can't be redefined), but they can nevertheless appear
143 in parallel/task regions and for default(none) purposes treat them as shared.
144 For vtables likely the same handling is desirable. */
145 if (TREE_CODE (decl) == VAR_DECL
146 && TREE_READONLY (decl)
147 && TREE_STATIC (decl))
148 return OMP_CLAUSE_DEFAULT_SHARED;
149
6c7a4dfd
JJ		 150 return OMP_CLAUSE_DEFAULT_UNSPECIFIED;
151}
152
79943d19
JJ		 153/* Return decl that should be used when reporting DEFAULT(NONE)
154 diagnostics. */
155
156tree
157gfc_omp_report_decl (tree decl)
158{
159 if (DECL_ARTIFICIAL (decl)
160 && DECL_LANG_SPECIFIC (decl)
161 && GFC_DECL_SAVED_DESCRIPTOR (decl))
162 return GFC_DECL_SAVED_DESCRIPTOR (decl);
163
164 return decl;
165}
cd75853e 166
92d28cbb
JJ		 167/* Return true if TYPE has any allocatable components. */
168
169static bool
170gfc_has_alloc_comps (tree type, tree decl)
171{
172 tree field, ftype;
173
174 if (POINTER_TYPE_P (type))
175 {
176 if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl))
177 type = TREE_TYPE (type);
178 else if (GFC_DECL_GET_SCALAR_POINTER (decl))
179 return false;
180 }
181
710700ab 182 if (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type))
92d28cbb
JJ		 183 type = gfc_get_element_type (type);
184
185 if (TREE_CODE (type) != RECORD_TYPE)
186 return false;
187
188 for (field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field))
189 {
190 ftype = TREE_TYPE (field);
191 if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field))
192 return true;
193 if (GFC_DESCRIPTOR_TYPE_P (ftype)
194 && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE)
195 return true;
196 if (gfc_has_alloc_comps (ftype, field))
197 return true;
198 }
199 return false;
200}
201
a68ab351
JJ		 202/* Return true if DECL in private clause needs
203 OMP_CLAUSE_PRIVATE_OUTER_REF on the private clause. */
204bool
205gfc_omp_private_outer_ref (tree decl)
206{
207 tree type = TREE_TYPE (decl);
208
209 if (GFC_DESCRIPTOR_TYPE_P (type)
210 && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE)
211 return true;
212
92d28cbb
JJ		 213 if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl))
214 return true;
215
216 if (gfc_omp_privatize_by_reference (decl))
217 type = TREE_TYPE (type);
218
219 if (gfc_has_alloc_comps (type, decl))
220 return true;
221
a68ab351
JJ		 222 return false;
223}
224
92d28cbb
JJ		 225/* Callback for gfc_omp_unshare_expr. */
226
227static tree
228gfc_omp_unshare_expr_r (tree *tp, int *walk_subtrees, void *)
229{
230 tree t = *tp;
231 enum tree_code code = TREE_CODE (t);
232
233 /* Stop at types, decls, constants like copy_tree_r. */
234 if (TREE_CODE_CLASS (code) == tcc_type
235 || TREE_CODE_CLASS (code) == tcc_declaration
236 || TREE_CODE_CLASS (code) == tcc_constant
237 || code == BLOCK)
238 *walk_subtrees = 0;
239 else if (handled_component_p (t)
240 || TREE_CODE (t) == MEM_REF)
241 {
242 *tp = unshare_expr (t);
243 *walk_subtrees = 0;
244 }
245
246 return NULL_TREE;
247}
248
249/* Unshare in expr anything that the FE which normally doesn't
250 care much about tree sharing (because during gimplification
251 everything is unshared) could cause problems with tree sharing
252 at omp-low.c time. */
253
254static tree
255gfc_omp_unshare_expr (tree expr)
256{
257 walk_tree (&expr, gfc_omp_unshare_expr_r, NULL, NULL);
258 return expr;
259}
260
261enum walk_alloc_comps
262{
263 WALK_ALLOC_COMPS_DTOR,
264 WALK_ALLOC_COMPS_DEFAULT_CTOR,
265 WALK_ALLOC_COMPS_COPY_CTOR
266};
267
268/* Handle allocatable components in OpenMP clauses. */
269
270static tree
271gfc_walk_alloc_comps (tree decl, tree dest, tree var,
272 enum walk_alloc_comps kind)
273{
274 stmtblock_t block, tmpblock;
275 tree type = TREE_TYPE (decl), then_b, tem, field;
276 gfc_init_block (&block);
277
278 if (GFC_ARRAY_TYPE_P (type) || GFC_DESCRIPTOR_TYPE_P (type))
279 {
280 if (GFC_DESCRIPTOR_TYPE_P (type))
281 {
282 gfc_init_block (&tmpblock);
283 tem = gfc_full_array_size (&tmpblock, decl,
284 GFC_TYPE_ARRAY_RANK (type));
285 then_b = gfc_finish_block (&tmpblock);
286 gfc_add_expr_to_block (&block, gfc_omp_unshare_expr (then_b));
287 tem = gfc_omp_unshare_expr (tem);
288 tem = fold_build2_loc (input_location, MINUS_EXPR,
289 gfc_array_index_type, tem,
290 gfc_index_one_node);
291 }
292 else
293 {
294 if (!TYPE_DOMAIN (type)
295 || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == NULL_TREE
296 || TYPE_MIN_VALUE (TYPE_DOMAIN (type)) == error_mark_node
297 || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == error_mark_node)
298 {
299 tem = fold_build2 (EXACT_DIV_EXPR, sizetype,
300 TYPE_SIZE_UNIT (type),
301 TYPE_SIZE_UNIT (TREE_TYPE (type)));
302 tem = size_binop (MINUS_EXPR, tem, size_one_node);
303 }
304 else
305 tem = array_type_nelts (type);
306 tem = fold_convert (gfc_array_index_type, tem);
307 }
308
309 tree nelems = gfc_evaluate_now (tem, &block);
310 tree index = gfc_create_var (gfc_array_index_type, "S");
311
312 gfc_init_block (&tmpblock);
313 tem = gfc_conv_array_data (decl);
314 tree declvar = build_fold_indirect_ref_loc (input_location, tem);
315 tree declvref = gfc_build_array_ref (declvar, index, NULL);
316 tree destvar, destvref = NULL_TREE;
317 if (dest)
318 {
319 tem = gfc_conv_array_data (dest);
320 destvar = build_fold_indirect_ref_loc (input_location, tem);
321 destvref = gfc_build_array_ref (destvar, index, NULL);
322 }
323 gfc_add_expr_to_block (&tmpblock,
324 gfc_walk_alloc_comps (declvref, destvref,
325 var, kind));
326
327 gfc_loopinfo loop;
328 gfc_init_loopinfo (&loop);
329 loop.dimen = 1;
330 loop.from[0] = gfc_index_zero_node;
331 loop.loopvar[0] = index;
332 loop.to[0] = nelems;
333 gfc_trans_scalarizing_loops (&loop, &tmpblock);
334 gfc_add_block_to_block (&block, &loop.pre);
335 return gfc_finish_block (&block);
336 }
337 else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (var))
338 {
339 decl = build_fold_indirect_ref_loc (input_location, decl);
340 if (dest)
341 dest = build_fold_indirect_ref_loc (input_location, dest);
342 type = TREE_TYPE (decl);
343 }
344
345 gcc_assert (TREE_CODE (type) == RECORD_TYPE);
346 for (field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field))
347 {
348 tree ftype = TREE_TYPE (field);
349 tree declf, destf = NULL_TREE;
350 bool has_alloc_comps = gfc_has_alloc_comps (ftype, field);
351 if ((!GFC_DESCRIPTOR_TYPE_P (ftype)
352 || GFC_TYPE_ARRAY_AKIND (ftype) != GFC_ARRAY_ALLOCATABLE)
353 && !GFC_DECL_GET_SCALAR_ALLOCATABLE (field)
354 && !has_alloc_comps)
355 continue;
356 declf = fold_build3_loc (input_location, COMPONENT_REF, ftype,
357 decl, field, NULL_TREE);
358 if (dest)
359 destf = fold_build3_loc (input_location, COMPONENT_REF, ftype,
360 dest, field, NULL_TREE);
361
362 tem = NULL_TREE;
363 switch (kind)
364 {
365 case WALK_ALLOC_COMPS_DTOR:
366 break;
367 case WALK_ALLOC_COMPS_DEFAULT_CTOR:
368 if (GFC_DESCRIPTOR_TYPE_P (ftype)
369 && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE)
370 {
371 gfc_add_modify (&block, unshare_expr (destf),
372 unshare_expr (declf));
373 tem = gfc_duplicate_allocatable_nocopy
374 (destf, declf, ftype,
375 GFC_TYPE_ARRAY_RANK (ftype));
376 }
377 else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field))
378 tem = gfc_duplicate_allocatable_nocopy (destf, declf, ftype, 0);
379 break;
380 case WALK_ALLOC_COMPS_COPY_CTOR:
381 if (GFC_DESCRIPTOR_TYPE_P (ftype)
382 && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE)
383 tem = gfc_duplicate_allocatable (destf, declf, ftype,
fc7d0afb
AV		 384 GFC_TYPE_ARRAY_RANK (ftype),
385 NULL_TREE);
92d28cbb 386 else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field))
fc7d0afb
AV		 387 tem = gfc_duplicate_allocatable (destf, declf, ftype, 0,
388 NULL_TREE);
92d28cbb
JJ		 389 break;
390 }
391 if (tem)
392 gfc_add_expr_to_block (&block, gfc_omp_unshare_expr (tem));
393 if (has_alloc_comps)
394 {
395 gfc_init_block (&tmpblock);
396 gfc_add_expr_to_block (&tmpblock,
397 gfc_walk_alloc_comps (declf, destf,
398 field, kind));
399 then_b = gfc_finish_block (&tmpblock);
400 if (GFC_DESCRIPTOR_TYPE_P (ftype)
401 && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE)
402 tem = gfc_conv_descriptor_data_get (unshare_expr (declf));
403 else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field))
404 tem = unshare_expr (declf);
405 else
406 tem = NULL_TREE;
407 if (tem)
408 {
409 tem = fold_convert (pvoid_type_node, tem);
410 tem = fold_build2_loc (input_location, NE_EXPR,
411 boolean_type_node, tem,
412 null_pointer_node);
413 then_b = build3_loc (input_location, COND_EXPR, void_type_node,
414 tem, then_b,
415 build_empty_stmt (input_location));
416 }
417 gfc_add_expr_to_block (&block, then_b);
418 }
419 if (kind == WALK_ALLOC_COMPS_DTOR)
420 {
421 if (GFC_DESCRIPTOR_TYPE_P (ftype)
422 && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE)
423 {
424 tem = gfc_trans_dealloc_allocated (unshare_expr (declf),
425 false, NULL);
426 gfc_add_expr_to_block (&block, gfc_omp_unshare_expr (tem));
427 }
428 else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field))
429 {
430 tem = gfc_call_free (unshare_expr (declf));
431 gfc_add_expr_to_block (&block, gfc_omp_unshare_expr (tem));
432 }
433 }
434 }
435
436 return gfc_finish_block (&block);
437}
438
cd75853e
JJ		 439/* Return code to initialize DECL with its default constructor, or
440 NULL if there's nothing to do. */
441
442tree
a68ab351 443gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer)
cd75853e 444{
92d28cbb 445 tree type = TREE_TYPE (decl), size, ptr, cond, then_b, else_b;
a68ab351 446 stmtblock_t block, cond_block;
cd75853e 447
92d28cbb
JJ		 448 gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_PRIVATE
449 || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LASTPRIVATE
450 || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR
451 || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_REDUCTION);
cd75853e 452
92d28cbb
JJ		 453 if ((! GFC_DESCRIPTOR_TYPE_P (type)
454 || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
455 && !GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause)))
456 {
457 if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
458 {
459 gcc_assert (outer);
460 gfc_start_block (&block);
461 tree tem = gfc_walk_alloc_comps (outer, decl,
462 OMP_CLAUSE_DECL (clause),
463 WALK_ALLOC_COMPS_DEFAULT_CTOR);
464 gfc_add_expr_to_block (&block, tem);
465 return gfc_finish_block (&block);
466 }
467 return NULL_TREE;
468 }
acf0174b 469
92d28cbb 470 gcc_assert (outer != NULL_TREE);
a68ab351 471
92d28cbb 472 /* Allocatable arrays and scalars in PRIVATE clauses need to be set to
a68ab351
JJ		 473 "not currently allocated" allocation status if outer
474 array is "not currently allocated", otherwise should be allocated. */
475 gfc_start_block (&block);
476
477 gfc_init_block (&cond_block);
478
92d28cbb
JJ		 479 if (GFC_DESCRIPTOR_TYPE_P (type))
480 {
481 gfc_add_modify (&cond_block, decl, outer);
482 tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
483 size = gfc_conv_descriptor_ubound_get (decl, rank);
484 size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
485 size,
486 gfc_conv_descriptor_lbound_get (decl, rank));
487 size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
488 size, gfc_index_one_node);
489 if (GFC_TYPE_ARRAY_RANK (type) > 1)
490 size = fold_build2_loc (input_location, MULT_EXPR,
491 gfc_array_index_type, size,
492 gfc_conv_descriptor_stride_get (decl, rank));
493 tree esize = fold_convert (gfc_array_index_type,
494 TYPE_SIZE_UNIT (gfc_get_element_type (type)));
495 size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
496 size, esize);
497 size = unshare_expr (size);
498 size = gfc_evaluate_now (fold_convert (size_type_node, size),
499 &cond_block);
500 }
501 else
502 size = fold_convert (size_type_node, TYPE_SIZE_UNIT (TREE_TYPE (type)));
4f13e17f
DC		 503 ptr = gfc_create_var (pvoid_type_node, NULL);
504 gfc_allocate_using_malloc (&cond_block, ptr, size, NULL_TREE);
92d28cbb
JJ		 505 if (GFC_DESCRIPTOR_TYPE_P (type))
506 gfc_conv_descriptor_data_set (&cond_block, unshare_expr (decl), ptr);
507 else
508 gfc_add_modify (&cond_block, unshare_expr (decl),
509 fold_convert (TREE_TYPE (decl), ptr));
510 if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
511 {
512 tree tem = gfc_walk_alloc_comps (outer, decl,
513 OMP_CLAUSE_DECL (clause),
514 WALK_ALLOC_COMPS_DEFAULT_CTOR);
515 gfc_add_expr_to_block (&cond_block, tem);
516 }
a68ab351
JJ		 517 then_b = gfc_finish_block (&cond_block);
518
92d28cbb
JJ		 519 /* Reduction clause requires allocated ALLOCATABLE. */
520 if (OMP_CLAUSE_CODE (clause) != OMP_CLAUSE_REDUCTION)
521 {
522 gfc_init_block (&cond_block);
523 if (GFC_DESCRIPTOR_TYPE_P (type))
524 gfc_conv_descriptor_data_set (&cond_block, unshare_expr (decl),
525 null_pointer_node);
526 else
527 gfc_add_modify (&cond_block, unshare_expr (decl),
528 build_zero_cst (TREE_TYPE (decl)));
529 else_b = gfc_finish_block (&cond_block);
530
531 tree tem = fold_convert (pvoid_type_node,
532 GFC_DESCRIPTOR_TYPE_P (type)
533 ? gfc_conv_descriptor_data_get (outer) : outer);
534 tem = unshare_expr (tem);
535 cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
536 tem, null_pointer_node);
537 gfc_add_expr_to_block (&block,
538 build3_loc (input_location, COND_EXPR,
539 void_type_node, cond, then_b,
540 else_b));
541 }
542 else
543 gfc_add_expr_to_block (&block, then_b);
cd75853e 544
a68ab351
JJ		 545 return gfc_finish_block (&block);
546}
547
548/* Build and return code for a copy constructor from SRC to DEST. */
549
550tree
551gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
552{
92d28cbb 553 tree type = TREE_TYPE (dest), ptr, size, call;
20906c66
JJ		 554 tree cond, then_b, else_b;
555 stmtblock_t block, cond_block;
a68ab351 556
92d28cbb
JJ		 557 gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_FIRSTPRIVATE
558 || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR);
a68ab351 559
92d28cbb
JJ		 560 if ((! GFC_DESCRIPTOR_TYPE_P (type)
561 || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
562 && !GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause)))
563 {
564 if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
565 {
566 gfc_start_block (&block);
567 gfc_add_modify (&block, dest, src);
568 tree tem = gfc_walk_alloc_comps (src, dest, OMP_CLAUSE_DECL (clause),
569 WALK_ALLOC_COMPS_COPY_CTOR);
570 gfc_add_expr_to_block (&block, tem);
571 return gfc_finish_block (&block);
572 }
573 else
574 return build2_v (MODIFY_EXPR, dest, src);
575 }
a68ab351
JJ		 576
577 /* Allocatable arrays in FIRSTPRIVATE clauses need to be allocated
578 and copied from SRC. */
579 gfc_start_block (&block);
580
20906c66
JJ		 581 gfc_init_block (&cond_block);
582
583 gfc_add_modify (&cond_block, dest, src);
92d28cbb
JJ		 584 if (GFC_DESCRIPTOR_TYPE_P (type))
585 {
586 tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
587 size = gfc_conv_descriptor_ubound_get (dest, rank);
588 size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
589 size,
590 gfc_conv_descriptor_lbound_get (dest, rank));
591 size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
592 size, gfc_index_one_node);
593 if (GFC_TYPE_ARRAY_RANK (type) > 1)
594 size = fold_build2_loc (input_location, MULT_EXPR,
595 gfc_array_index_type, size,
596 gfc_conv_descriptor_stride_get (dest, rank));
597 tree esize = fold_convert (gfc_array_index_type,
598 TYPE_SIZE_UNIT (gfc_get_element_type (type)));
599 size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
600 size, esize);
601 size = unshare_expr (size);
602 size = gfc_evaluate_now (fold_convert (size_type_node, size),
603 &cond_block);
604 }
605 else
606 size = fold_convert (size_type_node, TYPE_SIZE_UNIT (TREE_TYPE (type)));
4f13e17f 607 ptr = gfc_create_var (pvoid_type_node, NULL);
20906c66 608 gfc_allocate_using_malloc (&cond_block, ptr, size, NULL_TREE);
92d28cbb
JJ		 609 if (GFC_DESCRIPTOR_TYPE_P (type))
610 gfc_conv_descriptor_data_set (&cond_block, unshare_expr (dest), ptr);
611 else
612 gfc_add_modify (&cond_block, unshare_expr (dest),
613 fold_convert (TREE_TYPE (dest), ptr));
4f13e17f 614
92d28cbb
JJ		 615 tree srcptr = GFC_DESCRIPTOR_TYPE_P (type)
616 ? gfc_conv_descriptor_data_get (src) : src;
617 srcptr = unshare_expr (srcptr);
618 srcptr = fold_convert (pvoid_type_node, srcptr);
db3927fb 619 call = build_call_expr_loc (input_location,
92d28cbb
JJ		 620 builtin_decl_explicit (BUILT_IN_MEMCPY), 3, ptr,
621 srcptr, size);
20906c66 622 gfc_add_expr_to_block (&cond_block, fold_convert (void_type_node, call));
92d28cbb
JJ		 623 if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
624 {
625 tree tem = gfc_walk_alloc_comps (src, dest,
626 OMP_CLAUSE_DECL (clause),
627 WALK_ALLOC_COMPS_COPY_CTOR);
628 gfc_add_expr_to_block (&cond_block, tem);
629 }
20906c66
JJ		 630 then_b = gfc_finish_block (&cond_block);
631
632 gfc_init_block (&cond_block);
92d28cbb
JJ		 633 if (GFC_DESCRIPTOR_TYPE_P (type))
634 gfc_conv_descriptor_data_set (&cond_block, unshare_expr (dest),
635 null_pointer_node);
636 else
637 gfc_add_modify (&cond_block, unshare_expr (dest),
638 build_zero_cst (TREE_TYPE (dest)));
20906c66
JJ		 639 else_b = gfc_finish_block (&cond_block);
640
641 cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
92d28cbb
JJ		 642 unshare_expr (srcptr), null_pointer_node);
643 gfc_add_expr_to_block (&block,
644 build3_loc (input_location, COND_EXPR,
645 void_type_node, cond, then_b, else_b));
cd75853e
JJ		 646
647 return gfc_finish_block (&block);
648}
649
92d28cbb
JJ		 650/* Similarly, except use an intrinsic or pointer assignment operator
651 instead. */
a68ab351
JJ		 652
653tree
92d28cbb 654gfc_omp_clause_assign_op (tree clause, tree dest, tree src)
a68ab351 655{
92d28cbb
JJ		 656 tree type = TREE_TYPE (dest), ptr, size, call, nonalloc;
657 tree cond, then_b, else_b;
658 stmtblock_t block, cond_block, cond_block2, inner_block;
a68ab351 659
92d28cbb
JJ		 660 if ((! GFC_DESCRIPTOR_TYPE_P (type)
661 || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
662 && !GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause)))
663 {
664 if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
665 {
666 gfc_start_block (&block);
667 /* First dealloc any allocatable components in DEST. */
668 tree tem = gfc_walk_alloc_comps (dest, NULL_TREE,
669 OMP_CLAUSE_DECL (clause),
670 WALK_ALLOC_COMPS_DTOR);
671 gfc_add_expr_to_block (&block, tem);
672 /* Then copy over toplevel data. */
673 gfc_add_modify (&block, dest, src);
674 /* Finally allocate any allocatable components and copy. */
675 tem = gfc_walk_alloc_comps (src, dest, OMP_CLAUSE_DECL (clause),
676 WALK_ALLOC_COMPS_COPY_CTOR);
677 gfc_add_expr_to_block (&block, tem);
678 return gfc_finish_block (&block);
679 }
680 else
681 return build2_v (MODIFY_EXPR, dest, src);
682 }
a68ab351 683
a68ab351
JJ		 684 gfc_start_block (&block);
685
92d28cbb
JJ		 686 if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
687 {
688 then_b = gfc_walk_alloc_comps (dest, NULL_TREE, OMP_CLAUSE_DECL (clause),
689 WALK_ALLOC_COMPS_DTOR);
690 tree tem = fold_convert (pvoid_type_node,
691 GFC_DESCRIPTOR_TYPE_P (type)
692 ? gfc_conv_descriptor_data_get (dest) : dest);
693 tem = unshare_expr (tem);
694 cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
695 tem, null_pointer_node);
696 tem = build3_loc (input_location, COND_EXPR, void_type_node, cond,
697 then_b, build_empty_stmt (input_location));
698 gfc_add_expr_to_block (&block, tem);
699 }
700
701 gfc_init_block (&cond_block);
702
703 if (GFC_DESCRIPTOR_TYPE_P (type))
704 {
705 tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
706 size = gfc_conv_descriptor_ubound_get (src, rank);
707 size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
708 size,
709 gfc_conv_descriptor_lbound_get (src, rank));
710 size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
711 size, gfc_index_one_node);
712 if (GFC_TYPE_ARRAY_RANK (type) > 1)
713 size = fold_build2_loc (input_location, MULT_EXPR,
714 gfc_array_index_type, size,
715 gfc_conv_descriptor_stride_get (src, rank));
716 tree esize = fold_convert (gfc_array_index_type,
717 TYPE_SIZE_UNIT (gfc_get_element_type (type)));
718 size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
719 size, esize);
720 size = unshare_expr (size);
721 size = gfc_evaluate_now (fold_convert (size_type_node, size),
722 &cond_block);
723 }
724 else
725 size = fold_convert (size_type_node, TYPE_SIZE_UNIT (TREE_TYPE (type)));
726 ptr = gfc_create_var (pvoid_type_node, NULL);
727
728 tree destptr = GFC_DESCRIPTOR_TYPE_P (type)
729 ? gfc_conv_descriptor_data_get (dest) : dest;
730 destptr = unshare_expr (destptr);
731 destptr = fold_convert (pvoid_type_node, destptr);
732 gfc_add_modify (&cond_block, ptr, destptr);
733
734 nonalloc = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
735 destptr, null_pointer_node);
736 cond = nonalloc;
737 if (GFC_DESCRIPTOR_TYPE_P (type))
738 {
739 int i;
740 for (i = 0; i < GFC_TYPE_ARRAY_RANK (type); i++)
741 {
742 tree rank = gfc_rank_cst[i];
743 tree tem = gfc_conv_descriptor_ubound_get (src, rank);
744 tem = fold_build2_loc (input_location, MINUS_EXPR,
745 gfc_array_index_type, tem,
746 gfc_conv_descriptor_lbound_get (src, rank));
747 tem = fold_build2_loc (input_location, PLUS_EXPR,
748 gfc_array_index_type, tem,
749 gfc_conv_descriptor_lbound_get (dest, rank));
750 tem = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
751 tem, gfc_conv_descriptor_ubound_get (dest,
752 rank));
753 cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR,
754 boolean_type_node, cond, tem);
755 }
756 }
757
758 gfc_init_block (&cond_block2);
759
760 if (GFC_DESCRIPTOR_TYPE_P (type))
761 {
762 gfc_init_block (&inner_block);
763 gfc_allocate_using_malloc (&inner_block, ptr, size, NULL_TREE);
764 then_b = gfc_finish_block (&inner_block);
765
766 gfc_init_block (&inner_block);
767 gfc_add_modify (&inner_block, ptr,
768 gfc_call_realloc (&inner_block, ptr, size));
769 else_b = gfc_finish_block (&inner_block);
770
771 gfc_add_expr_to_block (&cond_block2,
772 build3_loc (input_location, COND_EXPR,
773 void_type_node,
774 unshare_expr (nonalloc),
775 then_b, else_b));
776 gfc_add_modify (&cond_block2, dest, src);
777 gfc_conv_descriptor_data_set (&cond_block2, unshare_expr (dest), ptr);
778 }
779 else
780 {
781 gfc_allocate_using_malloc (&cond_block2, ptr, size, NULL_TREE);
782 gfc_add_modify (&cond_block2, unshare_expr (dest),
783 fold_convert (type, ptr));
784 }
785 then_b = gfc_finish_block (&cond_block2);
786 else_b = build_empty_stmt (input_location);
787
788 gfc_add_expr_to_block (&cond_block,
789 build3_loc (input_location, COND_EXPR,
790 void_type_node, unshare_expr (cond),
791 then_b, else_b));
792
793 tree srcptr = GFC_DESCRIPTOR_TYPE_P (type)
794 ? gfc_conv_descriptor_data_get (src) : src;
795 srcptr = unshare_expr (srcptr);
796 srcptr = fold_convert (pvoid_type_node, srcptr);
db3927fb 797 call = build_call_expr_loc (input_location,
92d28cbb
JJ		 798 builtin_decl_explicit (BUILT_IN_MEMCPY), 3, ptr,
799 srcptr, size);
800 gfc_add_expr_to_block (&cond_block, fold_convert (void_type_node, call));
801 if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
802 {
803 tree tem = gfc_walk_alloc_comps (src, dest,
804 OMP_CLAUSE_DECL (clause),
805 WALK_ALLOC_COMPS_COPY_CTOR);
806 gfc_add_expr_to_block (&cond_block, tem);
807 }
808 then_b = gfc_finish_block (&cond_block);
809
810 if (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_COPYIN)
811 {
812 gfc_init_block (&cond_block);
813 if (GFC_DESCRIPTOR_TYPE_P (type))
814 gfc_add_expr_to_block (&cond_block,
815 gfc_trans_dealloc_allocated (unshare_expr (dest),
816 false, NULL));
817 else
818 {
819 destptr = gfc_evaluate_now (destptr, &cond_block);
820 gfc_add_expr_to_block (&cond_block, gfc_call_free (destptr));
821 gfc_add_modify (&cond_block, unshare_expr (dest),
822 build_zero_cst (TREE_TYPE (dest)));
823 }
824 else_b = gfc_finish_block (&cond_block);
825
826 cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
827 unshare_expr (srcptr), null_pointer_node);
828 gfc_add_expr_to_block (&block,
829 build3_loc (input_location, COND_EXPR,
830 void_type_node, cond,
831 then_b, else_b));
832 }
833 else
834 gfc_add_expr_to_block (&block, then_b);
a68ab351
JJ		 835
836 return gfc_finish_block (&block);
837}
838
da6f124d
JJ		 839static void
840gfc_omp_linear_clause_add_loop (stmtblock_t *block, tree dest, tree src,
841 tree add, tree nelems)
842{
843 stmtblock_t tmpblock;
844 tree desta, srca, index = gfc_create_var (gfc_array_index_type, "S");
845 nelems = gfc_evaluate_now (nelems, block);
846
847 gfc_init_block (&tmpblock);
848 if (TREE_CODE (TREE_TYPE (dest)) == ARRAY_TYPE)
849 {
850 desta = gfc_build_array_ref (dest, index, NULL);
851 srca = gfc_build_array_ref (src, index, NULL);
852 }
853 else
854 {
855 gcc_assert (POINTER_TYPE_P (TREE_TYPE (dest)));
856 tree idx = fold_build2 (MULT_EXPR, sizetype,
857 fold_convert (sizetype, index),
858 TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (dest))));
859 desta = build_fold_indirect_ref (fold_build2 (POINTER_PLUS_EXPR,
860 TREE_TYPE (dest), dest,
861 idx));
862 srca = build_fold_indirect_ref (fold_build2 (POINTER_PLUS_EXPR,
863 TREE_TYPE (src), src,
864 idx));
865 }
866 gfc_add_modify (&tmpblock, desta,
867 fold_build2 (PLUS_EXPR, TREE_TYPE (desta),
868 srca, add));
869
870 gfc_loopinfo loop;
871 gfc_init_loopinfo (&loop);
872 loop.dimen = 1;
873 loop.from[0] = gfc_index_zero_node;
874 loop.loopvar[0] = index;
875 loop.to[0] = nelems;
876 gfc_trans_scalarizing_loops (&loop, &tmpblock);
877 gfc_add_block_to_block (block, &loop.pre);
878}
879
880/* Build and return code for a constructor of DEST that initializes
881 it to SRC plus ADD (ADD is scalar integer). */
882
883tree
884gfc_omp_clause_linear_ctor (tree clause, tree dest, tree src, tree add)
885{
886 tree type = TREE_TYPE (dest), ptr, size, nelems = NULL_TREE;
887 stmtblock_t block;
888
889 gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR);
890
891 gfc_start_block (&block);
892 add = gfc_evaluate_now (add, &block);
893
894 if ((! GFC_DESCRIPTOR_TYPE_P (type)
895 || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
896 && !GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause)))
897 {
898 gcc_assert (TREE_CODE (type) == ARRAY_TYPE);
899 if (!TYPE_DOMAIN (type)
900 || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == NULL_TREE
901 || TYPE_MIN_VALUE (TYPE_DOMAIN (type)) == error_mark_node
902 || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == error_mark_node)
903 {
904 nelems = fold_build2 (EXACT_DIV_EXPR, sizetype,
905 TYPE_SIZE_UNIT (type),
906 TYPE_SIZE_UNIT (TREE_TYPE (type)));
907 nelems = size_binop (MINUS_EXPR, nelems, size_one_node);
908 }
909 else
910 nelems = array_type_nelts (type);
911 nelems = fold_convert (gfc_array_index_type, nelems);
912
913 gfc_omp_linear_clause_add_loop (&block, dest, src, add, nelems);
914 return gfc_finish_block (&block);
915 }
916
917 /* Allocatable arrays in LINEAR clauses need to be allocated
918 and copied from SRC. */
919 gfc_add_modify (&block, dest, src);
920 if (GFC_DESCRIPTOR_TYPE_P (type))
921 {
922 tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
923 size = gfc_conv_descriptor_ubound_get (dest, rank);
924 size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
925 size,
926 gfc_conv_descriptor_lbound_get (dest, rank));
927 size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
928 size, gfc_index_one_node);
929 if (GFC_TYPE_ARRAY_RANK (type) > 1)
930 size = fold_build2_loc (input_location, MULT_EXPR,
931 gfc_array_index_type, size,
932 gfc_conv_descriptor_stride_get (dest, rank));
933 tree esize = fold_convert (gfc_array_index_type,
934 TYPE_SIZE_UNIT (gfc_get_element_type (type)));
935 nelems = gfc_evaluate_now (unshare_expr (size), &block);
936 size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
937 nelems, unshare_expr (esize));
938 size = gfc_evaluate_now (fold_convert (size_type_node, size),
939 &block);
940 nelems = fold_build2_loc (input_location, MINUS_EXPR,
941 gfc_array_index_type, nelems,
942 gfc_index_one_node);
943 }
944 else
945 size = fold_convert (size_type_node, TYPE_SIZE_UNIT (TREE_TYPE (type)));
946 ptr = gfc_create_var (pvoid_type_node, NULL);
947 gfc_allocate_using_malloc (&block, ptr, size, NULL_TREE);
948 if (GFC_DESCRIPTOR_TYPE_P (type))
949 {
950 gfc_conv_descriptor_data_set (&block, unshare_expr (dest), ptr);
951 tree etype = gfc_get_element_type (type);
952 ptr = fold_convert (build_pointer_type (etype), ptr);
953 tree srcptr = gfc_conv_descriptor_data_get (unshare_expr (src));
954 srcptr = fold_convert (build_pointer_type (etype), srcptr);
955 gfc_omp_linear_clause_add_loop (&block, ptr, srcptr, add, nelems);
956 }
957 else
958 {
959 gfc_add_modify (&block, unshare_expr (dest),
960 fold_convert (TREE_TYPE (dest), ptr));
961 ptr = fold_convert (TREE_TYPE (dest), ptr);
962 tree dstm = build_fold_indirect_ref (ptr);
963 tree srcm = build_fold_indirect_ref (unshare_expr (src));
964 gfc_add_modify (&block, dstm,
965 fold_build2 (PLUS_EXPR, TREE_TYPE (add), srcm, add));
966 }
967 return gfc_finish_block (&block);
968}
969
a68ab351
JJ		 970/* Build and return code destructing DECL. Return NULL if nothing
971 to be done. */
972
973tree
92d28cbb 974gfc_omp_clause_dtor (tree clause, tree decl)
a68ab351 975{
92d28cbb 976 tree type = TREE_TYPE (decl), tem;
a68ab351 977
92d28cbb
JJ		 978 if ((! GFC_DESCRIPTOR_TYPE_P (type)
979 || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
980 && !GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause)))
981 {
982 if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
983 return gfc_walk_alloc_comps (decl, NULL_TREE,
984 OMP_CLAUSE_DECL (clause),
985 WALK_ALLOC_COMPS_DTOR);
986 return NULL_TREE;
987 }
a68ab351 988
92d28cbb
JJ		 989 if (GFC_DESCRIPTOR_TYPE_P (type))
990 /* Allocatable arrays in FIRSTPRIVATE/LASTPRIVATE etc. clauses need
991 to be deallocated if they were allocated. */
992 tem = gfc_trans_dealloc_allocated (decl, false, NULL);
993 else
994 tem = gfc_call_free (decl);
995 tem = gfc_omp_unshare_expr (tem);
acf0174b 996
92d28cbb
JJ		 997 if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
998 {
999 stmtblock_t block;
1000 tree then_b;
1001
1002 gfc_init_block (&block);
1003 gfc_add_expr_to_block (&block,
1004 gfc_walk_alloc_comps (decl, NULL_TREE,
1005 OMP_CLAUSE_DECL (clause),
1006 WALK_ALLOC_COMPS_DTOR));
1007 gfc_add_expr_to_block (&block, tem);
1008 then_b = gfc_finish_block (&block);
1009
1010 tem = fold_convert (pvoid_type_node,
1011 GFC_DESCRIPTOR_TYPE_P (type)
1012 ? gfc_conv_descriptor_data_get (decl) : decl);
1013 tem = unshare_expr (tem);
1014 tree cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
1015 tem, null_pointer_node);
1016 tem = build3_loc (input_location, COND_EXPR, void_type_node, cond,
1017 then_b, build_empty_stmt (input_location));
1018 }
1019 return tem;
a68ab351
JJ		 1020}
1021
cd75853e 1022
f014c653
JJ		 1023void
1024gfc_omp_finish_clause (tree c, gimple_seq *pre_p)
1025{
1026 if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_MAP)
1027 return;
1028
1029 tree decl = OMP_CLAUSE_DECL (c);
1030 tree c2 = NULL_TREE, c3 = NULL_TREE, c4 = NULL_TREE;
1031 if (POINTER_TYPE_P (TREE_TYPE (decl)))
1032 {
1033 if (!gfc_omp_privatize_by_reference (decl)
1034 && !GFC_DECL_GET_SCALAR_POINTER (decl)
1035 && !GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
1036 && !GFC_DECL_CRAY_POINTEE (decl)
1037 && !GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (decl))))
1038 return;
94351473 1039 tree orig_decl = decl;
f014c653 1040 c4 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP);
41dbbb37 1041 OMP_CLAUSE_SET_MAP_KIND (c4, GOMP_MAP_POINTER);
f014c653
JJ		 1042 OMP_CLAUSE_DECL (c4) = decl;
1043 OMP_CLAUSE_SIZE (c4) = size_int (0);
1044 decl = build_fold_indirect_ref (decl);
1045 OMP_CLAUSE_DECL (c) = decl;
b46ebd6c 1046 OMP_CLAUSE_SIZE (c) = NULL_TREE;
94351473
JJ		 1047 if (TREE_CODE (TREE_TYPE (orig_decl)) == REFERENCE_TYPE
1048 && (GFC_DECL_GET_SCALAR_POINTER (orig_decl)
1049 || GFC_DECL_GET_SCALAR_ALLOCATABLE (orig_decl)))
1050 {
1051 c3 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP);
41dbbb37 1052 OMP_CLAUSE_SET_MAP_KIND (c3, GOMP_MAP_POINTER);
94351473
JJ		 1053 OMP_CLAUSE_DECL (c3) = unshare_expr (decl);
1054 OMP_CLAUSE_SIZE (c3) = size_int (0);
1055 decl = build_fold_indirect_ref (decl);
1056 OMP_CLAUSE_DECL (c) = decl;
1057 }
f014c653
JJ		 1058 }
1059 if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
1060 {
1061 stmtblock_t block;
1062 gfc_start_block (&block);
1063 tree type = TREE_TYPE (decl);
1064 tree ptr = gfc_conv_descriptor_data_get (decl);
1065 ptr = fold_convert (build_pointer_type (char_type_node), ptr);
1066 ptr = build_fold_indirect_ref (ptr);
1067 OMP_CLAUSE_DECL (c) = ptr;
1068 c2 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
41dbbb37 1069 OMP_CLAUSE_SET_MAP_KIND (c2, GOMP_MAP_TO_PSET);
f014c653
JJ		 1070 OMP_CLAUSE_DECL (c2) = decl;
1071 OMP_CLAUSE_SIZE (c2) = TYPE_SIZE_UNIT (type);
1072 c3 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP);
41dbbb37 1073 OMP_CLAUSE_SET_MAP_KIND (c3, GOMP_MAP_POINTER);
f014c653
JJ		 1074 OMP_CLAUSE_DECL (c3) = gfc_conv_descriptor_data_get (decl);
1075 OMP_CLAUSE_SIZE (c3) = size_int (0);
b731b390 1076 tree size = create_tmp_var (gfc_array_index_type);
f014c653
JJ		 1077 tree elemsz = TYPE_SIZE_UNIT (gfc_get_element_type (type));
1078 elemsz = fold_convert (gfc_array_index_type, elemsz);
1079 if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER
1080 || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT)
1081 {
1082 stmtblock_t cond_block;
1083 tree tem, then_b, else_b, zero, cond;
1084
1085 gfc_init_block (&cond_block);
1086 tem = gfc_full_array_size (&cond_block, decl,
1087 GFC_TYPE_ARRAY_RANK (type));
1088 gfc_add_modify (&cond_block, size, tem);
1089 gfc_add_modify (&cond_block, size,
1090 fold_build2 (MULT_EXPR, gfc_array_index_type,
1091 size, elemsz));
1092 then_b = gfc_finish_block (&cond_block);
1093 gfc_init_block (&cond_block);
1094 zero = build_int_cst (gfc_array_index_type, 0);
1095 gfc_add_modify (&cond_block, size, zero);
1096 else_b = gfc_finish_block (&cond_block);
1097 tem = gfc_conv_descriptor_data_get (decl);
1098 tem = fold_convert (pvoid_type_node, tem);
1099 cond = fold_build2_loc (input_location, NE_EXPR,
1100 boolean_type_node, tem, null_pointer_node);
1101 gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR,
1102 void_type_node, cond,
1103 then_b, else_b));
1104 }
1105 else
1106 {
1107 gfc_add_modify (&block, size,
1108 gfc_full_array_size (&block, decl,
1109 GFC_TYPE_ARRAY_RANK (type)));
1110 gfc_add_modify (&block, size,
1111 fold_build2 (MULT_EXPR, gfc_array_index_type,
1112 size, elemsz));
1113 }
1114 OMP_CLAUSE_SIZE (c) = size;
1115 tree stmt = gfc_finish_block (&block);
1116 gimplify_and_add (stmt, pre_p);
1117 }
1118 tree last = c;
b46ebd6c
JJ		 1119 if (OMP_CLAUSE_SIZE (c) == NULL_TREE)
1120 OMP_CLAUSE_SIZE (c)
1121 = DECL_P (decl) ? DECL_SIZE_UNIT (decl)
1122 : TYPE_SIZE_UNIT (TREE_TYPE (decl));
f014c653
JJ		 1123 if (c2)
1124 {
1125 OMP_CLAUSE_CHAIN (c2) = OMP_CLAUSE_CHAIN (last);
1126 OMP_CLAUSE_CHAIN (last) = c2;
1127 last = c2;
1128 }
1129 if (c3)
1130 {
1131 OMP_CLAUSE_CHAIN (c3) = OMP_CLAUSE_CHAIN (last);
1132 OMP_CLAUSE_CHAIN (last) = c3;
1133 last = c3;
1134 }
1135 if (c4)
1136 {
1137 OMP_CLAUSE_CHAIN (c4) = OMP_CLAUSE_CHAIN (last);
1138 OMP_CLAUSE_CHAIN (last) = c4;
1139 last = c4;
1140 }
1141}
1142
1143
6c7a4dfd
JJ		 1144/* Return true if DECL's DECL_VALUE_EXPR (if any) should be
1145 disregarded in OpenMP construct, because it is going to be
1146 remapped during OpenMP lowering. SHARED is true if DECL
1147 is going to be shared, false if it is going to be privatized. */
1148
1149bool
1150gfc_omp_disregard_value_expr (tree decl, bool shared)
1151{
1152 if (GFC_DECL_COMMON_OR_EQUIV (decl)
1153 && DECL_HAS_VALUE_EXPR_P (decl))
1154 {
1155 tree value = DECL_VALUE_EXPR (decl);
1156
1157 if (TREE_CODE (value) == COMPONENT_REF
1158 && TREE_CODE (TREE_OPERAND (value, 0)) == VAR_DECL
1159 && GFC_DECL_COMMON_OR_EQUIV (TREE_OPERAND (value, 0)))
1160 {
1161 /* If variable in COMMON or EQUIVALENCE is privatized, return
1162 true, as just that variable is supposed to be privatized,
1163 not the whole COMMON or whole EQUIVALENCE.
1164 For shared variables in COMMON or EQUIVALENCE, let them be
1165 gimplified to DECL_VALUE_EXPR, so that for multiple shared vars
1166 from the same COMMON or EQUIVALENCE just one sharing of the
1167 whole COMMON or EQUIVALENCE is enough. */
1168 return ! shared;
1169 }
1170 }
1171
1172 if (GFC_DECL_RESULT (decl) && DECL_HAS_VALUE_EXPR_P (decl))
1173 return ! shared;
1174
1175 return false;
1176}
1177
1178/* Return true if DECL that is shared iff SHARED is true should
1179 be put into OMP_CLAUSE_PRIVATE with OMP_CLAUSE_PRIVATE_DEBUG
1180 flag set. */
1181
1182bool
1183gfc_omp_private_debug_clause (tree decl, bool shared)
1184{
1185 if (GFC_DECL_CRAY_POINTEE (decl))
1186 return true;
1187
1188 if (GFC_DECL_COMMON_OR_EQUIV (decl)
1189 && DECL_HAS_VALUE_EXPR_P (decl))
1190 {
1191 tree value = DECL_VALUE_EXPR (decl);
1192
1193 if (TREE_CODE (value) == COMPONENT_REF
1194 && TREE_CODE (TREE_OPERAND (value, 0)) == VAR_DECL
1195 && GFC_DECL_COMMON_OR_EQUIV (TREE_OPERAND (value, 0)))
1196 return shared;
1197 }
1198
1199 return false;
1200}
1201
1202/* Register language specific type size variables as potentially OpenMP
1203 firstprivate variables. */
1204
1205void
1206gfc_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *ctx, tree type)
1207{
1208 if (GFC_ARRAY_TYPE_P (type) || GFC_DESCRIPTOR_TYPE_P (type))
1209 {
1210 int r;
1211
1212 gcc_assert (TYPE_LANG_SPECIFIC (type) != NULL);
1213 for (r = 0; r < GFC_TYPE_ARRAY_RANK (type); r++)
1214 {
1215 omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_LBOUND (type, r));
1216 omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_UBOUND (type, r));
1217 omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_STRIDE (type, r));
1218 }
1219 omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_SIZE (type));
1220 omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_OFFSET (type));
1221 }
1222}
1223
1224
1225static inline tree
1226gfc_trans_add_clause (tree node, tree tail)
1227{
1228 OMP_CLAUSE_CHAIN (node) = tail;
1229 return node;
1230}
1231
1232static tree
dd2fc525 1233gfc_trans_omp_variable (gfc_symbol *sym, bool declare_simd)
6c7a4dfd 1234{
dd2fc525
JJ		 1235 if (declare_simd)
1236 {
1237 int cnt = 0;
1238 gfc_symbol *proc_sym;
1239 gfc_formal_arglist *f;
1240
1241 gcc_assert (sym->attr.dummy);
1242 proc_sym = sym->ns->proc_name;
1243 if (proc_sym->attr.entry_master)
1244 ++cnt;
1245 if (gfc_return_by_reference (proc_sym))
1246 {
1247 ++cnt;
1248 if (proc_sym->ts.type == BT_CHARACTER)
1249 ++cnt;
1250 }
1251 for (f = gfc_sym_get_dummy_args (proc_sym); f; f = f->next)
1252 if (f->sym == sym)
1253 break;
1254 else if (f->sym)
1255 ++cnt;
1256 gcc_assert (f);
1257 return build_int_cst (integer_type_node, cnt);
1258 }
1259
6c7a4dfd 1260 tree t = gfc_get_symbol_decl (sym);
11a5f608
JJ		 1261 tree parent_decl;
1262 int parent_flag;
1263 bool return_value;
1264 bool alternate_entry;
1265 bool entry_master;
1266
1267 return_value = sym->attr.function && sym->result == sym;
1268 alternate_entry = sym->attr.function && sym->attr.entry
1269 && sym->result == sym;
1270 entry_master = sym->attr.result
1271 && sym->ns->proc_name->attr.entry_master
1272 && !gfc_return_by_reference (sym->ns->proc_name);
dd2fc525
JJ		 1273 parent_decl = current_function_decl
1274 ? DECL_CONTEXT (current_function_decl) : NULL_TREE;
11a5f608
JJ		 1275
1276 if ((t == parent_decl && return_value)
1277 || (sym->ns && sym->ns->proc_name
1278 && sym->ns->proc_name->backend_decl == parent_decl
1279 && (alternate_entry || entry_master)))
1280 parent_flag = 1;
1281 else
1282 parent_flag = 0;
6c7a4dfd
JJ		 1283
1284 /* Special case for assigning the return value of a function.
1285 Self recursive functions must have an explicit return value. */
11a5f608
JJ		 1286 if (return_value && (t == current_function_decl || parent_flag))
1287 t = gfc_get_fake_result_decl (sym, parent_flag);
6c7a4dfd
JJ		 1288
1289 /* Similarly for alternate entry points. */
11a5f608
JJ		 1290 else if (alternate_entry
1291 && (sym->ns->proc_name->backend_decl == current_function_decl
1292 || parent_flag))
6c7a4dfd
JJ		 1293 {
1294 gfc_entry_list *el = NULL;
1295
1296 for (el = sym->ns->entries; el; el = el->next)
1297 if (sym == el->sym)
1298 {
11a5f608 1299 t = gfc_get_fake_result_decl (sym, parent_flag);
6c7a4dfd
JJ		 1300 break;
1301 }
1302 }
1303
11a5f608
JJ		 1304 else if (entry_master
1305 && (sym->ns->proc_name->backend_decl == current_function_decl
1306 || parent_flag))
1307 t = gfc_get_fake_result_decl (sym, parent_flag);
6c7a4dfd
JJ		 1308
1309 return t;
1310}
1311
1312static tree
dd2fc525
JJ		 1313gfc_trans_omp_variable_list (enum omp_clause_code code,
1314 gfc_omp_namelist *namelist, tree list,
1315 bool declare_simd)
6c7a4dfd
JJ		 1316{
1317 for (; namelist != NULL; namelist = namelist->next)
dd2fc525 1318 if (namelist->sym->attr.referenced || declare_simd)
6c7a4dfd 1319 {
dd2fc525 1320 tree t = gfc_trans_omp_variable (namelist->sym, declare_simd);
6c7a4dfd
JJ		 1321 if (t != error_mark_node)
1322 {
c2255bc4 1323 tree node = build_omp_clause (input_location, code);
6c7a4dfd
JJ		 1324 OMP_CLAUSE_DECL (node) = t;
1325 list = gfc_trans_add_clause (node, list);
1326 }
1327 }
1328 return list;
1329}
1330
5f23671d
JJ		 1331struct omp_udr_find_orig_data
1332{
1333 gfc_omp_udr *omp_udr;
1334 bool omp_orig_seen;
1335};
1336
1337static int
1338omp_udr_find_orig (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
1339 void *data)
1340{
1341 struct omp_udr_find_orig_data *cd = (struct omp_udr_find_orig_data *) data;
1342 if ((*e)->expr_type == EXPR_VARIABLE
1343 && (*e)->symtree->n.sym == cd->omp_udr->omp_orig)
1344 cd->omp_orig_seen = true;
1345
1346 return 0;
1347}
1348
6c7a4dfd 1349static void
5f23671d 1350gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
6c7a4dfd 1351{
5f23671d 1352 gfc_symbol *sym = n->sym;
6c7a4dfd
JJ		 1353 gfc_symtree *root1 = NULL, *root2 = NULL, *root3 = NULL, *root4 = NULL;
1354 gfc_symtree *symtree1, *symtree2, *symtree3, *symtree4 = NULL;
1355 gfc_symbol init_val_sym, outer_sym, intrinsic_sym;
5f23671d 1356 gfc_symbol omp_var_copy[4];
6c7a4dfd
JJ		 1357 gfc_expr *e1, *e2, *e3, *e4;
1358 gfc_ref *ref;
af3fcdb4 1359 tree decl, backend_decl, stmt, type, outer_decl;
6c7a4dfd
JJ		 1360 locus old_loc = gfc_current_locus;
1361 const char *iname;
524af0d6 1362 bool t;
b46ebd6c 1363 gfc_omp_udr *udr = n->udr ? n->udr->udr : NULL;
6c7a4dfd
JJ		 1364
1365 decl = OMP_CLAUSE_DECL (c);
1366 gfc_current_locus = where;
af3fcdb4 1367 type = TREE_TYPE (decl);
b731b390 1368 outer_decl = create_tmp_var_raw (type);
af3fcdb4
JJ		 1369 if (TREE_CODE (decl) == PARM_DECL
1370 && TREE_CODE (type) == REFERENCE_TYPE
1371 && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (type))
1372 && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (type)) == GFC_ARRAY_ALLOCATABLE)
1373 {
1374 decl = build_fold_indirect_ref (decl);
1375 type = TREE_TYPE (type);
1376 }
6c7a4dfd
JJ		 1377
1378 /* Create a fake symbol for init value. */
1379 memset (&init_val_sym, 0, sizeof (init_val_sym));
1380 init_val_sym.ns = sym->ns;
1381 init_val_sym.name = sym->name;
1382 init_val_sym.ts = sym->ts;
1383 init_val_sym.attr.referenced = 1;
1384 init_val_sym.declared_at = where;
a7a53ca5 1385 init_val_sym.attr.flavor = FL_VARIABLE;
5f23671d
JJ		 1386 if (OMP_CLAUSE_REDUCTION_CODE (c) != ERROR_MARK)
1387 backend_decl = omp_reduction_init (c, gfc_sym_type (&init_val_sym));
b46ebd6c 1388 else if (udr->initializer_ns)
5f23671d
JJ		 1389 backend_decl = NULL;
1390 else
1391 switch (sym->ts.type)
1392 {
1393 case BT_LOGICAL:
1394 case BT_INTEGER:
1395 case BT_REAL:
1396 case BT_COMPLEX:
1397 backend_decl = build_zero_cst (gfc_sym_type (&init_val_sym));
1398 break;
1399 default:
1400 backend_decl = NULL_TREE;
1401 break;
1402 }
6c7a4dfd
JJ		 1403 init_val_sym.backend_decl = backend_decl;
1404
1405 /* Create a fake symbol for the outer array reference. */
1406 outer_sym = *sym;
5f23671d
JJ		 1407 if (sym->as)
1408 outer_sym.as = gfc_copy_array_spec (sym->as);
6c7a4dfd
JJ		 1409 outer_sym.attr.dummy = 0;
1410 outer_sym.attr.result = 0;
a7a53ca5 1411 outer_sym.attr.flavor = FL_VARIABLE;
af3fcdb4
JJ		 1412 outer_sym.backend_decl = outer_decl;
1413 if (decl != OMP_CLAUSE_DECL (c))
1414 outer_sym.backend_decl = build_fold_indirect_ref (outer_decl);
6c7a4dfd
JJ		 1415
1416 /* Create fake symtrees for it. */
1417 symtree1 = gfc_new_symtree (&root1, sym->name);
1418 symtree1->n.sym = sym;
1419 gcc_assert (symtree1 == root1);
1420
1421 symtree2 = gfc_new_symtree (&root2, sym->name);
1422 symtree2->n.sym = &init_val_sym;
1423 gcc_assert (symtree2 == root2);
1424
1425 symtree3 = gfc_new_symtree (&root3, sym->name);
1426 symtree3->n.sym = &outer_sym;
1427 gcc_assert (symtree3 == root3);
1428
5f23671d 1429 memset (omp_var_copy, 0, sizeof omp_var_copy);
b46ebd6c 1430 if (udr)
5f23671d 1431 {
b46ebd6c
JJ		 1432 omp_var_copy[0] = *udr->omp_out;
1433 omp_var_copy[1] = *udr->omp_in;
1434 *udr->omp_out = outer_sym;
1435 *udr->omp_in = *sym;
1436 if (udr->initializer_ns)
5f23671d 1437 {
b46ebd6c
JJ		 1438 omp_var_copy[2] = *udr->omp_priv;
1439 omp_var_copy[3] = *udr->omp_orig;
1440 *udr->omp_priv = *sym;
1441 *udr->omp_orig = outer_sym;
5f23671d
JJ		 1442 }
1443 }
1444
6c7a4dfd
JJ		 1445 /* Create expressions. */
1446 e1 = gfc_get_expr ();
1447 e1->expr_type = EXPR_VARIABLE;
1448 e1->where = where;
1449 e1->symtree = symtree1;
1450 e1->ts = sym->ts;
5f23671d
JJ		 1451 if (sym->attr.dimension)
1452 {
1453 e1->ref = ref = gfc_get_ref ();
1454 ref->type = REF_ARRAY;
1455 ref->u.ar.where = where;
1456 ref->u.ar.as = sym->as;
1457 ref->u.ar.type = AR_FULL;
1458 ref->u.ar.dimen = 0;
1459 }
6c7a4dfd 1460 t = gfc_resolve_expr (e1);
524af0d6 1461 gcc_assert (t);
6c7a4dfd 1462
5f23671d
JJ		 1463 e2 = NULL;
1464 if (backend_decl != NULL_TREE)
1465 {
1466 e2 = gfc_get_expr ();
1467 e2->expr_type = EXPR_VARIABLE;
1468 e2->where = where;
1469 e2->symtree = symtree2;
1470 e2->ts = sym->ts;
1471 t = gfc_resolve_expr (e2);
1472 gcc_assert (t);
1473 }
b46ebd6c 1474 else if (udr->initializer_ns == NULL)
5f23671d
JJ		 1475 {
1476 gcc_assert (sym->ts.type == BT_DERIVED);
1477 e2 = gfc_default_initializer (&sym->ts);
1478 gcc_assert (e2);
1479 t = gfc_resolve_expr (e2);
1480 gcc_assert (t);
1481 }
b46ebd6c 1482 else if (n->udr->initializer->op == EXEC_ASSIGN)
5f23671d 1483 {
b46ebd6c
JJ		 1484 e2 = gfc_copy_expr (n->udr->initializer->expr2);
1485 t = gfc_resolve_expr (e2);
1486 gcc_assert (t);
5f23671d 1487 }
b46ebd6c 1488 if (udr && udr->initializer_ns)
5f23671d
JJ		 1489 {
1490 struct omp_udr_find_orig_data cd;
b46ebd6c 1491 cd.omp_udr = udr;
5f23671d 1492 cd.omp_orig_seen = false;
b46ebd6c 1493 gfc_code_walker (&n->udr->initializer,
5f23671d
JJ		 1494 gfc_dummy_code_callback, omp_udr_find_orig, &cd);
1495 if (cd.omp_orig_seen)
1496 OMP_CLAUSE_REDUCTION_OMP_ORIG_REF (c) = 1;
1497 }
6c7a4dfd
JJ		 1498
1499 e3 = gfc_copy_expr (e1);
1500 e3->symtree = symtree3;
1501 t = gfc_resolve_expr (e3);
524af0d6 1502 gcc_assert (t);
6c7a4dfd
JJ		 1503
1504 iname = NULL;
5f23671d 1505 e4 = NULL;
6c7a4dfd
JJ		 1506 switch (OMP_CLAUSE_REDUCTION_CODE (c))
1507 {
1508 case PLUS_EXPR:
1509 case MINUS_EXPR:
1510 e4 = gfc_add (e3, e1);
1511 break;
1512 case MULT_EXPR:
1513 e4 = gfc_multiply (e3, e1);
1514 break;
1515 case TRUTH_ANDIF_EXPR:
1516 e4 = gfc_and (e3, e1);
1517 break;
1518 case TRUTH_ORIF_EXPR:
1519 e4 = gfc_or (e3, e1);
1520 break;
1521 case EQ_EXPR:
1522 e4 = gfc_eqv (e3, e1);
1523 break;
1524 case NE_EXPR:
1525 e4 = gfc_neqv (e3, e1);
1526 break;
1527 case MIN_EXPR:
1528 iname = "min";
1529 break;
1530 case MAX_EXPR:
1531 iname = "max";
1532 break;
1533 case BIT_AND_EXPR:
1534 iname = "iand";
1535 break;
1536 case BIT_IOR_EXPR:
1537 iname = "ior";
1538 break;
1539 case BIT_XOR_EXPR:
1540 iname = "ieor";
1541 break;
5f23671d 1542 case ERROR_MARK:
b46ebd6c 1543 if (n->udr->combiner->op == EXEC_ASSIGN)
5f23671d 1544 {
b46ebd6c
JJ		 1545 gfc_free_expr (e3);
1546 e3 = gfc_copy_expr (n->udr->combiner->expr1);
1547 e4 = gfc_copy_expr (n->udr->combiner->expr2);
1548 t = gfc_resolve_expr (e3);
1549 gcc_assert (t);
1550 t = gfc_resolve_expr (e4);
1551 gcc_assert (t);
5f23671d
JJ		 1552 }
1553 break;
6c7a4dfd
JJ		 1554 default:
1555 gcc_unreachable ();
1556 }
1557 if (iname != NULL)
1558 {
1559 memset (&intrinsic_sym, 0, sizeof (intrinsic_sym));
1560 intrinsic_sym.ns = sym->ns;
1561 intrinsic_sym.name = iname;
1562 intrinsic_sym.ts = sym->ts;
1563 intrinsic_sym.attr.referenced = 1;
1564 intrinsic_sym.attr.intrinsic = 1;
1565 intrinsic_sym.attr.function = 1;
1566 intrinsic_sym.result = &intrinsic_sym;
1567 intrinsic_sym.declared_at = where;
1568
1569 symtree4 = gfc_new_symtree (&root4, iname);
1570 symtree4->n.sym = &intrinsic_sym;
1571 gcc_assert (symtree4 == root4);
1572
1573 e4 = gfc_get_expr ();
1574 e4->expr_type = EXPR_FUNCTION;
1575 e4->where = where;
1576 e4->symtree = symtree4;
6c7a4dfd
JJ		 1577 e4->value.function.actual = gfc_get_actual_arglist ();
1578 e4->value.function.actual->expr = e3;
1579 e4->value.function.actual->next = gfc_get_actual_arglist ();
1580 e4->value.function.actual->next->expr = e1;
1581 }
5f23671d
JJ		 1582 if (OMP_CLAUSE_REDUCTION_CODE (c) != ERROR_MARK)
1583 {
1584 /* e1 and e3 have been stored as arguments of e4, avoid sharing. */
1585 e1 = gfc_copy_expr (e1);
1586 e3 = gfc_copy_expr (e3);
1587 t = gfc_resolve_expr (e4);
1588 gcc_assert (t);
1589 }
6c7a4dfd
JJ		 1590
1591 /* Create the init statement list. */
87a60f68 1592 pushlevel ();
92d28cbb 1593 if (e2)
2b56d6a4 1594 stmt = gfc_trans_assignment (e1, e2, false, false);
5f23671d 1595 else
b46ebd6c 1596 stmt = gfc_trans_call (n->udr->initializer, false,
5f23671d 1597 NULL_TREE, NULL_TREE, false);
5b8fdd1f 1598 if (TREE_CODE (stmt) != BIND_EXPR)
87a60f68 1599 stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
5b8fdd1f 1600 else
87a60f68 1601 poplevel (0, 0);
5b8fdd1f 1602 OMP_CLAUSE_REDUCTION_INIT (c) = stmt;
6c7a4dfd
JJ		 1603
1604 /* Create the merge statement list. */
87a60f68 1605 pushlevel ();
92d28cbb 1606 if (e4)
2b56d6a4 1607 stmt = gfc_trans_assignment (e3, e4, false, true);
5f23671d 1608 else
b46ebd6c 1609 stmt = gfc_trans_call (n->udr->combiner, false,
5f23671d 1610 NULL_TREE, NULL_TREE, false);
5b8fdd1f 1611 if (TREE_CODE (stmt) != BIND_EXPR)
87a60f68 1612 stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
5b8fdd1f 1613 else
87a60f68 1614 poplevel (0, 0);
5b8fdd1f 1615 OMP_CLAUSE_REDUCTION_MERGE (c) = stmt;
6c7a4dfd
JJ		 1616
1617 /* And stick the placeholder VAR_DECL into the clause as well. */
af3fcdb4 1618 OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) = outer_decl;
6c7a4dfd
JJ		 1619
1620 gfc_current_locus = old_loc;
1621
1622 gfc_free_expr (e1);
5f23671d
JJ		 1623 if (e2)
1624 gfc_free_expr (e2);
6c7a4dfd 1625 gfc_free_expr (e3);
5f23671d
JJ		 1626 if (e4)
1627 gfc_free_expr (e4);
cede9502
JM		 1628 free (symtree1);
1629 free (symtree2);
1630 free (symtree3);
04695783 1631 free (symtree4);
5f23671d
JJ		 1632 if (outer_sym.as)
1633 gfc_free_array_spec (outer_sym.as);
1634
b46ebd6c 1635 if (udr)
5f23671d 1636 {
b46ebd6c
JJ		 1637 *udr->omp_out = omp_var_copy[0];
1638 *udr->omp_in = omp_var_copy[1];
1639 if (udr->initializer_ns)
5f23671d 1640 {
b46ebd6c
JJ		 1641 *udr->omp_priv = omp_var_copy[2];
1642 *udr->omp_orig = omp_var_copy[3];
5f23671d
JJ		 1643 }
1644 }
6c7a4dfd
JJ		 1645}
1646
1647static tree
dd2fc525 1648gfc_trans_omp_reduction_list (gfc_omp_namelist *namelist, tree list,
5f23671d 1649 locus where)
6c7a4dfd
JJ		 1650{
1651 for (; namelist != NULL; namelist = namelist->next)
1652 if (namelist->sym->attr.referenced)
1653 {
dd2fc525 1654 tree t = gfc_trans_omp_variable (namelist->sym, false);
6c7a4dfd
JJ		 1655 if (t != error_mark_node)
1656 {
c2255bc4
AH		 1657 tree node = build_omp_clause (where.lb->location,
1658 OMP_CLAUSE_REDUCTION);
6c7a4dfd 1659 OMP_CLAUSE_DECL (node) = t;
f014c653 1660 switch (namelist->u.reduction_op)
5f23671d
JJ		 1661 {
1662 case OMP_REDUCTION_PLUS:
1663 OMP_CLAUSE_REDUCTION_CODE (node) = PLUS_EXPR;
1664 break;
1665 case OMP_REDUCTION_MINUS:
1666 OMP_CLAUSE_REDUCTION_CODE (node) = MINUS_EXPR;
1667 break;
1668 case OMP_REDUCTION_TIMES:
1669 OMP_CLAUSE_REDUCTION_CODE (node) = MULT_EXPR;
1670 break;
1671 case OMP_REDUCTION_AND:
1672 OMP_CLAUSE_REDUCTION_CODE (node) = TRUTH_ANDIF_EXPR;
1673 break;
1674 case OMP_REDUCTION_OR:
1675 OMP_CLAUSE_REDUCTION_CODE (node) = TRUTH_ORIF_EXPR;
1676 break;
1677 case OMP_REDUCTION_EQV:
1678 OMP_CLAUSE_REDUCTION_CODE (node) = EQ_EXPR;
1679 break;
1680 case OMP_REDUCTION_NEQV:
1681 OMP_CLAUSE_REDUCTION_CODE (node) = NE_EXPR;
1682 break;
1683 case OMP_REDUCTION_MAX:
1684 OMP_CLAUSE_REDUCTION_CODE (node) = MAX_EXPR;
1685 break;
1686 case OMP_REDUCTION_MIN:
1687 OMP_CLAUSE_REDUCTION_CODE (node) = MIN_EXPR;
1688 break;
1689 case OMP_REDUCTION_IAND:
1690 OMP_CLAUSE_REDUCTION_CODE (node) = BIT_AND_EXPR;
1691 break;
1692 case OMP_REDUCTION_IOR:
1693 OMP_CLAUSE_REDUCTION_CODE (node) = BIT_IOR_EXPR;
1694 break;
1695 case OMP_REDUCTION_IEOR:
1696 OMP_CLAUSE_REDUCTION_CODE (node) = BIT_XOR_EXPR;
1697 break;
1698 case OMP_REDUCTION_USER:
1699 OMP_CLAUSE_REDUCTION_CODE (node) = ERROR_MARK;
1700 break;
1701 default:
1702 gcc_unreachable ();
1703 }
1704 if (namelist->sym->attr.dimension
f014c653 1705 || namelist->u.reduction_op == OMP_REDUCTION_USER
92d28cbb 1706 || namelist->sym->attr.allocatable)
5f23671d 1707 gfc_trans_omp_array_reduction_or_udr (node, namelist, where);
6c7a4dfd
JJ		 1708 list = gfc_trans_add_clause (node, list);
1709 }
1710 }
1711 return list;
1712}
1713
41dbbb37
TS		 1714static inline tree
1715gfc_convert_expr_to_tree (stmtblock_t *block, gfc_expr *expr)
1716{
1717 gfc_se se;
1718 tree result;
1719
1720 gfc_init_se (&se, NULL );
1721 gfc_conv_expr (&se, expr);
1722 gfc_add_block_to_block (block, &se.pre);
1723 result = gfc_evaluate_now (se.expr, block);
1724 gfc_add_block_to_block (block, &se.post);
1725
1726 return result;
1727}
1728
6c7a4dfd
JJ		 1729static tree
1730gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
dd2fc525 1731 locus where, bool declare_simd = false)
6c7a4dfd 1732{
c4fae39e 1733 tree omp_clauses = NULL_TREE, chunk_size, c;
6c7a4dfd
JJ		 1734 int list;
1735 enum omp_clause_code clause_code;
1736 gfc_se se;
1737
1738 if (clauses == NULL)
1739 return NULL_TREE;
1740
1741 for (list = 0; list < OMP_LIST_NUM; list++)
1742 {
dd2fc525 1743 gfc_omp_namelist *n = clauses->lists[list];
6c7a4dfd
JJ		 1744
1745 if (n == NULL)
1746 continue;
6c7a4dfd
JJ		 1747 switch (list)
1748 {
5f23671d
JJ		 1749 case OMP_LIST_REDUCTION:
1750 omp_clauses = gfc_trans_omp_reduction_list (n, omp_clauses, where);
1751 break;
6c7a4dfd
JJ		 1752 case OMP_LIST_PRIVATE:
1753 clause_code = OMP_CLAUSE_PRIVATE;
1754 goto add_clause;
1755 case OMP_LIST_SHARED:
1756 clause_code = OMP_CLAUSE_SHARED;
1757 goto add_clause;
1758 case OMP_LIST_FIRSTPRIVATE:
1759 clause_code = OMP_CLAUSE_FIRSTPRIVATE;
1760 goto add_clause;
1761 case OMP_LIST_LASTPRIVATE:
1762 clause_code = OMP_CLAUSE_LASTPRIVATE;
1763 goto add_clause;
1764 case OMP_LIST_COPYIN:
1765 clause_code = OMP_CLAUSE_COPYIN;
1766 goto add_clause;
1767 case OMP_LIST_COPYPRIVATE:
1768 clause_code = OMP_CLAUSE_COPYPRIVATE;
dd2fc525
JJ		 1769 goto add_clause;
1770 case OMP_LIST_UNIFORM:
1771 clause_code = OMP_CLAUSE_UNIFORM;
41dbbb37
TS		 1772 goto add_clause;
1773 case OMP_LIST_USE_DEVICE:
c7b48c8a 1774 clause_code = OMP_CLAUSE_USE_DEVICE_PTR;
41dbbb37
TS		 1775 goto add_clause;
1776 case OMP_LIST_DEVICE_RESIDENT:
1777 clause_code = OMP_CLAUSE_DEVICE_RESIDENT;
1778 goto add_clause;
41dbbb37 1779
6c7a4dfd
JJ		 1780 add_clause:
1781 omp_clauses
dd2fc525
JJ		 1782 = gfc_trans_omp_variable_list (clause_code, n, omp_clauses,
1783 declare_simd);
1784 break;
1785 case OMP_LIST_ALIGNED:
1786 for (; n != NULL; n = n->next)
1787 if (n->sym->attr.referenced || declare_simd)
1788 {
1789 tree t = gfc_trans_omp_variable (n->sym, declare_simd);
1790 if (t != error_mark_node)
1791 {
1792 tree node = build_omp_clause (input_location,
1793 OMP_CLAUSE_ALIGNED);
1794 OMP_CLAUSE_DECL (node) = t;
1795 if (n->expr)
1796 {
1797 tree alignment_var;
1798
1799 if (block == NULL)
1800 alignment_var = gfc_conv_constant_to_tree (n->expr);
1801 else
1802 {
1803 gfc_init_se (&se, NULL);
1804 gfc_conv_expr (&se, n->expr);
1805 gfc_add_block_to_block (block, &se.pre);
1806 alignment_var = gfc_evaluate_now (se.expr, block);
1807 gfc_add_block_to_block (block, &se.post);
1808 }
1809 OMP_CLAUSE_ALIGNED_ALIGNMENT (node) = alignment_var;
1810 }
1811 omp_clauses = gfc_trans_add_clause (node, omp_clauses);
1812 }
1813 }
1814 break;
1815 case OMP_LIST_LINEAR:
1816 {
1817 gfc_expr *last_step_expr = NULL;
1818 tree last_step = NULL_TREE;
1819
1820 for (; n != NULL; n = n->next)
1821 {
1822 if (n->expr)
1823 {
1824 last_step_expr = n->expr;
1825 last_step = NULL_TREE;
1826 }
1827 if (n->sym->attr.referenced || declare_simd)
1828 {
1829 tree t = gfc_trans_omp_variable (n->sym, declare_simd);
1830 if (t != error_mark_node)
1831 {
1832 tree node = build_omp_clause (input_location,
1833 OMP_CLAUSE_LINEAR);
1834 OMP_CLAUSE_DECL (node) = t;
1835 if (last_step_expr && last_step == NULL_TREE)
1836 {
1837 if (block == NULL)
1838 last_step
1839 = gfc_conv_constant_to_tree (last_step_expr);
1840 else
1841 {
1842 gfc_init_se (&se, NULL);
1843 gfc_conv_expr (&se, last_step_expr);
1844 gfc_add_block_to_block (block, &se.pre);
1845 last_step = gfc_evaluate_now (se.expr, block);
1846 gfc_add_block_to_block (block, &se.post);
1847 }
1848 }
da6f124d
JJ		 1849 OMP_CLAUSE_LINEAR_STEP (node)
1850 = fold_convert (gfc_typenode_for_spec (&n->sym->ts),
1851 last_step);
1852 if (n->sym->attr.dimension || n->sym->attr.allocatable)
1853 OMP_CLAUSE_LINEAR_ARRAY (node) = 1;
dd2fc525
JJ		 1854 omp_clauses = gfc_trans_add_clause (node, omp_clauses);
1855 }
1856 }
1857 }
1858 }
1859 break;
f014c653 1860 case OMP_LIST_DEPEND:
dd2fc525
JJ		 1861 for (; n != NULL; n = n->next)
1862 {
1863 if (!n->sym->attr.referenced)
1864 continue;
1865
1866 tree node = build_omp_clause (input_location, OMP_CLAUSE_DEPEND);
1867 if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
1868 {
f014c653
JJ		 1869 tree decl = gfc_get_symbol_decl (n->sym);
1870 if (gfc_omp_privatize_by_reference (decl))
1871 decl = build_fold_indirect_ref (decl);
1872 if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
1873 {
1874 decl = gfc_conv_descriptor_data_get (decl);
1875 decl = fold_convert (build_pointer_type (char_type_node),
1876 decl);
1877 decl = build_fold_indirect_ref (decl);
1878 }
1879 else if (DECL_P (decl))
1880 TREE_ADDRESSABLE (decl) = 1;
1881 OMP_CLAUSE_DECL (node) = decl;
dd2fc525
JJ		 1882 }
1883 else
1884 {
1885 tree ptr;
1886 gfc_init_se (&se, NULL);
1887 if (n->expr->ref->u.ar.type == AR_ELEMENT)
1888 {
1889 gfc_conv_expr_reference (&se, n->expr);
1890 ptr = se.expr;
1891 }
1892 else
1893 {
1894 gfc_conv_expr_descriptor (&se, n->expr);
1895 ptr = gfc_conv_array_data (se.expr);
1896 }
1897 gfc_add_block_to_block (block, &se.pre);
1898 gfc_add_block_to_block (block, &se.post);
f014c653
JJ		 1899 ptr = fold_convert (build_pointer_type (char_type_node),
1900 ptr);
1901 OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
1902 }
1903 switch (n->u.depend_op)
1904 {
1905 case OMP_DEPEND_IN:
1906 OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_IN;
1907 break;
1908 case OMP_DEPEND_OUT:
1909 OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_OUT;
1910 break;
1911 case OMP_DEPEND_INOUT:
1912 OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_INOUT;
1913 break;
1914 default:
1915 gcc_unreachable ();
1916 }
1917 omp_clauses = gfc_trans_add_clause (node, omp_clauses);
1918 }
1919 break;
1920 case OMP_LIST_MAP:
1921 for (; n != NULL; n = n->next)
1922 {
1923 if (!n->sym->attr.referenced)
1924 continue;
1925
1926 tree node = build_omp_clause (input_location, OMP_CLAUSE_MAP);
1927 tree node2 = NULL_TREE;
1928 tree node3 = NULL_TREE;
1929 tree node4 = NULL_TREE;
1930 tree decl = gfc_get_symbol_decl (n->sym);
1931 if (DECL_P (decl))
1932 TREE_ADDRESSABLE (decl) = 1;
1933 if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
1934 {
94351473
JJ		 1935 if (POINTER_TYPE_P (TREE_TYPE (decl))
1936 && (gfc_omp_privatize_by_reference (decl)
1937 || GFC_DECL_GET_SCALAR_POINTER (decl)
1938 || GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
1939 || GFC_DECL_CRAY_POINTEE (decl)
1940 || GFC_DESCRIPTOR_TYPE_P
1941 (TREE_TYPE (TREE_TYPE (decl)))))
f014c653 1942 {
94351473 1943 tree orig_decl = decl;
f014c653
JJ		 1944 node4 = build_omp_clause (input_location,
1945 OMP_CLAUSE_MAP);
41dbbb37 1946 OMP_CLAUSE_SET_MAP_KIND (node4, GOMP_MAP_POINTER);
f014c653
JJ		 1947 OMP_CLAUSE_DECL (node4) = decl;
1948 OMP_CLAUSE_SIZE (node4) = size_int (0);
1949 decl = build_fold_indirect_ref (decl);
94351473
JJ		 1950 if (TREE_CODE (TREE_TYPE (orig_decl)) == REFERENCE_TYPE
1951 && (GFC_DECL_GET_SCALAR_POINTER (orig_decl)
1952 || GFC_DECL_GET_SCALAR_ALLOCATABLE (orig_decl)))
1953 {
1954 node3 = build_omp_clause (input_location,
1955 OMP_CLAUSE_MAP);
41dbbb37 1956 OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_POINTER);
94351473
JJ		 1957 OMP_CLAUSE_DECL (node3) = decl;
1958 OMP_CLAUSE_SIZE (node3) = size_int (0);
1959 decl = build_fold_indirect_ref (decl);
1960 }
f014c653
JJ		 1961 }
1962 if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
1963 {
1964 tree type = TREE_TYPE (decl);
1965 tree ptr = gfc_conv_descriptor_data_get (decl);
1966 ptr = fold_convert (build_pointer_type (char_type_node),
1967 ptr);
1968 ptr = build_fold_indirect_ref (ptr);
1969 OMP_CLAUSE_DECL (node) = ptr;
1970 node2 = build_omp_clause (input_location,
1971 OMP_CLAUSE_MAP);
41dbbb37 1972 OMP_CLAUSE_SET_MAP_KIND (node2, GOMP_MAP_TO_PSET);
f014c653
JJ		 1973 OMP_CLAUSE_DECL (node2) = decl;
1974 OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type);
1975 node3 = build_omp_clause (input_location,
1976 OMP_CLAUSE_MAP);
41dbbb37 1977 OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_POINTER);
f014c653
JJ		 1978 OMP_CLAUSE_DECL (node3)
1979 = gfc_conv_descriptor_data_get (decl);
1980 OMP_CLAUSE_SIZE (node3) = size_int (0);
710700ab
TB		 1981
1982 /* We have to check for n->sym->attr.dimension because
1983 of scalar coarrays. */
1984 if (n->sym->attr.pointer && n->sym->attr.dimension)
f014c653
JJ		 1985 {
1986 stmtblock_t cond_block;
1987 tree size
1988 = gfc_create_var (gfc_array_index_type, NULL);
1989 tree tem, then_b, else_b, zero, cond;
1990
1991 gfc_init_block (&cond_block);
1992 tem
1993 = gfc_full_array_size (&cond_block, decl,
1994 GFC_TYPE_ARRAY_RANK (type));
1995 gfc_add_modify (&cond_block, size, tem);
1996 then_b = gfc_finish_block (&cond_block);
1997 gfc_init_block (&cond_block);
1998 zero = build_int_cst (gfc_array_index_type, 0);
1999 gfc_add_modify (&cond_block, size, zero);
2000 else_b = gfc_finish_block (&cond_block);
2001 tem = gfc_conv_descriptor_data_get (decl);
2002 tem = fold_convert (pvoid_type_node, tem);
2003 cond = fold_build2_loc (input_location, NE_EXPR,
2004 boolean_type_node,
2005 tem, null_pointer_node);
2006 gfc_add_expr_to_block (block,
2007 build3_loc (input_location,
2008 COND_EXPR,
2009 void_type_node,
2010 cond, then_b,
2011 else_b));
2012 OMP_CLAUSE_SIZE (node) = size;
2013 }
710700ab 2014 else if (n->sym->attr.dimension)
f014c653
JJ		 2015 OMP_CLAUSE_SIZE (node)
2016 = gfc_full_array_size (block, decl,
2017 GFC_TYPE_ARRAY_RANK (type));
710700ab
TB		 2018 if (n->sym->attr.dimension)
2019 {
2020 tree elemsz
2021 = TYPE_SIZE_UNIT (gfc_get_element_type (type));
2022 elemsz = fold_convert (gfc_array_index_type, elemsz);
2023 OMP_CLAUSE_SIZE (node)
2024 = fold_build2 (MULT_EXPR, gfc_array_index_type,
2025 OMP_CLAUSE_SIZE (node), elemsz);
2026 }
f014c653
JJ		 2027 }
2028 else
2029 OMP_CLAUSE_DECL (node) = decl;
2030 }
2031 else
2032 {
2033 tree ptr, ptr2;
2034 gfc_init_se (&se, NULL);
2035 if (n->expr->ref->u.ar.type == AR_ELEMENT)
2036 {
2037 gfc_conv_expr_reference (&se, n->expr);
2038 gfc_add_block_to_block (block, &se.pre);
2039 ptr = se.expr;
2040 OMP_CLAUSE_SIZE (node)
2041 = TYPE_SIZE_UNIT (TREE_TYPE (ptr));
2042 }
2043 else
2044 {
2045 gfc_conv_expr_descriptor (&se, n->expr);
2046 ptr = gfc_conv_array_data (se.expr);
2047 tree type = TREE_TYPE (se.expr);
2048 gfc_add_block_to_block (block, &se.pre);
2049 OMP_CLAUSE_SIZE (node)
2050 = gfc_full_array_size (block, se.expr,
2051 GFC_TYPE_ARRAY_RANK (type));
2052 tree elemsz
2053 = TYPE_SIZE_UNIT (gfc_get_element_type (type));
2054 elemsz = fold_convert (gfc_array_index_type, elemsz);
2055 OMP_CLAUSE_SIZE (node)
2056 = fold_build2 (MULT_EXPR, gfc_array_index_type,
2057 OMP_CLAUSE_SIZE (node), elemsz);
2058 }
2059 gfc_add_block_to_block (block, &se.post);
2060 ptr = fold_convert (build_pointer_type (char_type_node),
2061 ptr);
2062 OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
2063
2064 if (POINTER_TYPE_P (TREE_TYPE (decl))
2065 && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (decl))))
2066 {
2067 node4 = build_omp_clause (input_location,
2068 OMP_CLAUSE_MAP);
41dbbb37 2069 OMP_CLAUSE_SET_MAP_KIND (node4, GOMP_MAP_POINTER);
f014c653
JJ		 2070 OMP_CLAUSE_DECL (node4) = decl;
2071 OMP_CLAUSE_SIZE (node4) = size_int (0);
2072 decl = build_fold_indirect_ref (decl);
2073 }
2074 ptr = fold_convert (sizetype, ptr);
2075 if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
2076 {
2077 tree type = TREE_TYPE (decl);
2078 ptr2 = gfc_conv_descriptor_data_get (decl);
2079 node2 = build_omp_clause (input_location,
2080 OMP_CLAUSE_MAP);
41dbbb37 2081 OMP_CLAUSE_SET_MAP_KIND (node2, GOMP_MAP_TO_PSET);
f014c653
JJ		 2082 OMP_CLAUSE_DECL (node2) = decl;
2083 OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type);
2084 node3 = build_omp_clause (input_location,
2085 OMP_CLAUSE_MAP);
41dbbb37 2086 OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_POINTER);
f014c653
JJ		 2087 OMP_CLAUSE_DECL (node3)
2088 = gfc_conv_descriptor_data_get (decl);
2089 }
2090 else
2091 {
2092 if (TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE)
2093 ptr2 = build_fold_addr_expr (decl);
2094 else
2095 {
2096 gcc_assert (POINTER_TYPE_P (TREE_TYPE (decl)));
2097 ptr2 = decl;
2098 }
2099 node3 = build_omp_clause (input_location,
2100 OMP_CLAUSE_MAP);
41dbbb37 2101 OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_POINTER);
f014c653
JJ		 2102 OMP_CLAUSE_DECL (node3) = decl;
2103 }
2104 ptr2 = fold_convert (sizetype, ptr2);
2105 OMP_CLAUSE_SIZE (node3)
2106 = fold_build2 (MINUS_EXPR, sizetype, ptr, ptr2);
2107 }
2108 switch (n->u.map_op)
2109 {
2110 case OMP_MAP_ALLOC:
41dbbb37 2111 OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALLOC);
f014c653
JJ		 2112 break;
2113 case OMP_MAP_TO:
41dbbb37 2114 OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_TO);
f014c653
JJ		 2115 break;
2116 case OMP_MAP_FROM:
41dbbb37 2117 OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FROM);
f014c653
JJ		 2118 break;
2119 case OMP_MAP_TOFROM:
41dbbb37
TS		 2120 OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_TOFROM);
2121 break;
2122 case OMP_MAP_FORCE_ALLOC:
2123 OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_ALLOC);
2124 break;
2125 case OMP_MAP_FORCE_DEALLOC:
2126 OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_DEALLOC);
2127 break;
2128 case OMP_MAP_FORCE_TO:
2129 OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_TO);
2130 break;
2131 case OMP_MAP_FORCE_FROM:
2132 OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_FROM);
2133 break;
2134 case OMP_MAP_FORCE_TOFROM:
2135 OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_TOFROM);
2136 break;
2137 case OMP_MAP_FORCE_PRESENT:
2138 OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_PRESENT);
2139 break;
2140 case OMP_MAP_FORCE_DEVICEPTR:
2141 OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_DEVICEPTR);
f014c653
JJ		 2142 break;
2143 default:
2144 gcc_unreachable ();
2145 }
2146 omp_clauses = gfc_trans_add_clause (node, omp_clauses);
2147 if (node2)
2148 omp_clauses = gfc_trans_add_clause (node2, omp_clauses);
2149 if (node3)
2150 omp_clauses = gfc_trans_add_clause (node3, omp_clauses);
2151 if (node4)
2152 omp_clauses = gfc_trans_add_clause (node4, omp_clauses);
2153 }
2154 break;
2155 case OMP_LIST_TO:
2156 case OMP_LIST_FROM:
33497fd2 2157 case OMP_LIST_CACHE:
f014c653
JJ		 2158 for (; n != NULL; n = n->next)
2159 {
2160 if (!n->sym->attr.referenced)
2161 continue;
2162
33497fd2
TS		 2163 switch (list)
2164 {
2165 case OMP_LIST_TO:
2166 clause_code = OMP_CLAUSE_TO;
2167 break;
2168 case OMP_LIST_FROM:
2169 clause_code = OMP_CLAUSE_FROM;
2170 break;
2171 case OMP_LIST_CACHE:
2172 clause_code = OMP_CLAUSE__CACHE_;
2173 break;
2174 default:
2175 gcc_unreachable ();
2176 }
2177 tree node = build_omp_clause (input_location, clause_code);
f014c653
JJ		 2178 if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
2179 {
2180 tree decl = gfc_get_symbol_decl (n->sym);
2181 if (gfc_omp_privatize_by_reference (decl))
2182 decl = build_fold_indirect_ref (decl);
2183 if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
2184 {
2185 tree type = TREE_TYPE (decl);
2186 tree ptr = gfc_conv_descriptor_data_get (decl);
2187 ptr = fold_convert (build_pointer_type (char_type_node),
2188 ptr);
2189 ptr = build_fold_indirect_ref (ptr);
2190 OMP_CLAUSE_DECL (node) = ptr;
2191 OMP_CLAUSE_SIZE (node)
2192 = gfc_full_array_size (block, decl,
2193 GFC_TYPE_ARRAY_RANK (type));
2194 tree elemsz
2195 = TYPE_SIZE_UNIT (gfc_get_element_type (type));
2196 elemsz = fold_convert (gfc_array_index_type, elemsz);
2197 OMP_CLAUSE_SIZE (node)
2198 = fold_build2 (MULT_EXPR, gfc_array_index_type,
2199 OMP_CLAUSE_SIZE (node), elemsz);
2200 }
2201 else
2202 OMP_CLAUSE_DECL (node) = decl;
2203 }
2204 else
2205 {
2206 tree ptr;
2207 gfc_init_se (&se, NULL);
2208 if (n->expr->ref->u.ar.type == AR_ELEMENT)
2209 {
2210 gfc_conv_expr_reference (&se, n->expr);
2211 ptr = se.expr;
2212 gfc_add_block_to_block (block, &se.pre);
2213 OMP_CLAUSE_SIZE (node)
2214 = TYPE_SIZE_UNIT (TREE_TYPE (ptr));
2215 }
2216 else
2217 {
2218 gfc_conv_expr_descriptor (&se, n->expr);
2219 ptr = gfc_conv_array_data (se.expr);
2220 tree type = TREE_TYPE (se.expr);
2221 gfc_add_block_to_block (block, &se.pre);
2222 OMP_CLAUSE_SIZE (node)
2223 = gfc_full_array_size (block, se.expr,
2224 GFC_TYPE_ARRAY_RANK (type));
2225 tree elemsz
2226 = TYPE_SIZE_UNIT (gfc_get_element_type (type));
2227 elemsz = fold_convert (gfc_array_index_type, elemsz);
2228 OMP_CLAUSE_SIZE (node)
2229 = fold_build2 (MULT_EXPR, gfc_array_index_type,
2230 OMP_CLAUSE_SIZE (node), elemsz);
2231 }
2232 gfc_add_block_to_block (block, &se.post);
2233 ptr = fold_convert (build_pointer_type (char_type_node),
2234 ptr);
2235 OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
dd2fc525 2236 }
dd2fc525
JJ		 2237 omp_clauses = gfc_trans_add_clause (node, omp_clauses);
2238 }
6c7a4dfd
JJ		 2239 break;
2240 default:
2241 break;
2242 }
2243 }
2244
2245 if (clauses->if_expr)
2246 {
2247 tree if_var;
2248
2249 gfc_init_se (&se, NULL);
2250 gfc_conv_expr (&se, clauses->if_expr);
2251 gfc_add_block_to_block (block, &se.pre);
2252 if_var = gfc_evaluate_now (se.expr, block);
2253 gfc_add_block_to_block (block, &se.post);
2254
c2255bc4 2255 c = build_omp_clause (where.lb->location, OMP_CLAUSE_IF);
d9a6bd32 2256 OMP_CLAUSE_IF_MODIFIER (c) = ERROR_MARK;
6c7a4dfd
JJ		 2257 OMP_CLAUSE_IF_EXPR (c) = if_var;
2258 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2259 }
2260
20906c66
JJ		 2261 if (clauses->final_expr)
2262 {
2263 tree final_var;
2264
2265 gfc_init_se (&se, NULL);
2266 gfc_conv_expr (&se, clauses->final_expr);
2267 gfc_add_block_to_block (block, &se.pre);
2268 final_var = gfc_evaluate_now (se.expr, block);
2269 gfc_add_block_to_block (block, &se.post);
2270
2271 c = build_omp_clause (where.lb->location, OMP_CLAUSE_FINAL);
2272 OMP_CLAUSE_FINAL_EXPR (c) = final_var;
2273 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2274 }
2275
6c7a4dfd
JJ		 2276 if (clauses->num_threads)
2277 {
2278 tree num_threads;
2279
2280 gfc_init_se (&se, NULL);
2281 gfc_conv_expr (&se, clauses->num_threads);
2282 gfc_add_block_to_block (block, &se.pre);
2283 num_threads = gfc_evaluate_now (se.expr, block);
2284 gfc_add_block_to_block (block, &se.post);
2285
c2255bc4 2286 c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_THREADS);
6c7a4dfd
JJ		 2287 OMP_CLAUSE_NUM_THREADS_EXPR (c) = num_threads;
2288 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2289 }
2290
2291 chunk_size = NULL_TREE;
2292 if (clauses->chunk_size)
2293 {
2294 gfc_init_se (&se, NULL);
2295 gfc_conv_expr (&se, clauses->chunk_size);
2296 gfc_add_block_to_block (block, &se.pre);
2297 chunk_size = gfc_evaluate_now (se.expr, block);
2298 gfc_add_block_to_block (block, &se.post);
2299 }
2300
2301 if (clauses->sched_kind != OMP_SCHED_NONE)
2302 {
c2255bc4 2303 c = build_omp_clause (where.lb->location, OMP_CLAUSE_SCHEDULE);
6c7a4dfd
JJ		 2304 OMP_CLAUSE_SCHEDULE_CHUNK_EXPR (c) = chunk_size;
2305 switch (clauses->sched_kind)
2306 {
2307 case OMP_SCHED_STATIC:
2308 OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_STATIC;
2309 break;
2310 case OMP_SCHED_DYNAMIC:
2311 OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_DYNAMIC;
2312 break;
2313 case OMP_SCHED_GUIDED:
2314 OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_GUIDED;
2315 break;
2316 case OMP_SCHED_RUNTIME:
2317 OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_RUNTIME;
2318 break;
a68ab351
JJ		 2319 case OMP_SCHED_AUTO:
2320 OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_AUTO;
2321 break;
6c7a4dfd
JJ		 2322 default:
2323 gcc_unreachable ();
2324 }
2325 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2326 }
2327
2328 if (clauses->default_sharing != OMP_DEFAULT_UNKNOWN)
2329 {
c2255bc4 2330 c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEFAULT);
6c7a4dfd
JJ		 2331 switch (clauses->default_sharing)
2332 {
2333 case OMP_DEFAULT_NONE:
2334 OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_NONE;
2335 break;
2336 case OMP_DEFAULT_SHARED:
2337 OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_SHARED;
2338 break;
2339 case OMP_DEFAULT_PRIVATE:
2340 OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_PRIVATE;
2341 break;
a68ab351
JJ		 2342 case OMP_DEFAULT_FIRSTPRIVATE:
2343 OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_FIRSTPRIVATE;
2344 break;
6c7a4dfd
JJ		 2345 default:
2346 gcc_unreachable ();
2347 }
2348 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2349 }
2350
2351 if (clauses->nowait)
2352 {
c2255bc4 2353 c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOWAIT);
6c7a4dfd
JJ		 2354 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2355 }
2356
2357 if (clauses->ordered)
2358 {
c2255bc4 2359 c = build_omp_clause (where.lb->location, OMP_CLAUSE_ORDERED);
d9a6bd32 2360 OMP_CLAUSE_ORDERED_EXPR (c) = NULL_TREE;
6c7a4dfd
JJ		 2361 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2362 }
2363
a68ab351
JJ		 2364 if (clauses->untied)
2365 {
c2255bc4 2366 c = build_omp_clause (where.lb->location, OMP_CLAUSE_UNTIED);
a68ab351
JJ		 2367 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2368 }
2369
20906c66
JJ		 2370 if (clauses->mergeable)
2371 {
2372 c = build_omp_clause (where.lb->location, OMP_CLAUSE_MERGEABLE);
2373 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2374 }
2375
a68ab351
JJ		 2376 if (clauses->collapse)
2377 {
c2255bc4 2378 c = build_omp_clause (where.lb->location, OMP_CLAUSE_COLLAPSE);
df09d1d5
RG		 2379 OMP_CLAUSE_COLLAPSE_EXPR (c)
2380 = build_int_cst (integer_type_node, clauses->collapse);
a68ab351
JJ		 2381 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2382 }
2383
dd2fc525
JJ		 2384 if (clauses->inbranch)
2385 {
2386 c = build_omp_clause (where.lb->location, OMP_CLAUSE_INBRANCH);
2387 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2388 }
2389
2390 if (clauses->notinbranch)
2391 {
2392 c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOTINBRANCH);
2393 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2394 }
2395
2396 switch (clauses->cancel)
2397 {
2398 case OMP_CANCEL_UNKNOWN:
2399 break;
2400 case OMP_CANCEL_PARALLEL:
2401 c = build_omp_clause (where.lb->location, OMP_CLAUSE_PARALLEL);
2402 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2403 break;
2404 case OMP_CANCEL_SECTIONS:
2405 c = build_omp_clause (where.lb->location, OMP_CLAUSE_SECTIONS);
2406 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2407 break;
2408 case OMP_CANCEL_DO:
2409 c = build_omp_clause (where.lb->location, OMP_CLAUSE_FOR);
2410 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2411 break;
2412 case OMP_CANCEL_TASKGROUP:
2413 c = build_omp_clause (where.lb->location, OMP_CLAUSE_TASKGROUP);
2414 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2415 break;
2416 }
2417
2418 if (clauses->proc_bind != OMP_PROC_BIND_UNKNOWN)
2419 {
2420 c = build_omp_clause (where.lb->location, OMP_CLAUSE_PROC_BIND);
2421 switch (clauses->proc_bind)
2422 {
2423 case OMP_PROC_BIND_MASTER:
2424 OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_MASTER;
2425 break;
2426 case OMP_PROC_BIND_SPREAD:
2427 OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_SPREAD;
2428 break;
2429 case OMP_PROC_BIND_CLOSE:
2430 OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_CLOSE;
2431 break;
2432 default:
2433 gcc_unreachable ();
2434 }
2435 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2436 }
2437
2438 if (clauses->safelen_expr)
2439 {
2440 tree safelen_var;
2441
2442 gfc_init_se (&se, NULL);
2443 gfc_conv_expr (&se, clauses->safelen_expr);
2444 gfc_add_block_to_block (block, &se.pre);
2445 safelen_var = gfc_evaluate_now (se.expr, block);
2446 gfc_add_block_to_block (block, &se.post);
2447
2448 c = build_omp_clause (where.lb->location, OMP_CLAUSE_SAFELEN);
2449 OMP_CLAUSE_SAFELEN_EXPR (c) = safelen_var;
2450 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2451 }
2452
2453 if (clauses->simdlen_expr)
2454 {
2455 c = build_omp_clause (where.lb->location, OMP_CLAUSE_SIMDLEN);
2456 OMP_CLAUSE_SIMDLEN_EXPR (c)
2457 = gfc_conv_constant_to_tree (clauses->simdlen_expr);
2458 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2459 }
2460
f014c653
JJ		 2461 if (clauses->num_teams)
2462 {
2463 tree num_teams;
2464
2465 gfc_init_se (&se, NULL);
2466 gfc_conv_expr (&se, clauses->num_teams);
2467 gfc_add_block_to_block (block, &se.pre);
2468 num_teams = gfc_evaluate_now (se.expr, block);
2469 gfc_add_block_to_block (block, &se.post);
2470
2471 c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_TEAMS);
2472 OMP_CLAUSE_NUM_TEAMS_EXPR (c) = num_teams;
2473 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2474 }
2475
2476 if (clauses->device)
2477 {
2478 tree device;
2479
2480 gfc_init_se (&se, NULL);
2481 gfc_conv_expr (&se, clauses->device);
2482 gfc_add_block_to_block (block, &se.pre);
2483 device = gfc_evaluate_now (se.expr, block);
2484 gfc_add_block_to_block (block, &se.post);
2485
2486 c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEVICE);
2487 OMP_CLAUSE_DEVICE_ID (c) = device;
2488 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2489 }
2490
2491 if (clauses->thread_limit)
2492 {
2493 tree thread_limit;
2494
2495 gfc_init_se (&se, NULL);
2496 gfc_conv_expr (&se, clauses->thread_limit);
2497 gfc_add_block_to_block (block, &se.pre);
2498 thread_limit = gfc_evaluate_now (se.expr, block);
2499 gfc_add_block_to_block (block, &se.post);
2500
2501 c = build_omp_clause (where.lb->location, OMP_CLAUSE_THREAD_LIMIT);
2502 OMP_CLAUSE_THREAD_LIMIT_EXPR (c) = thread_limit;
2503 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2504 }
2505
2506 chunk_size = NULL_TREE;
2507 if (clauses->dist_chunk_size)
2508 {
2509 gfc_init_se (&se, NULL);
2510 gfc_conv_expr (&se, clauses->dist_chunk_size);
2511 gfc_add_block_to_block (block, &se.pre);
2512 chunk_size = gfc_evaluate_now (se.expr, block);
2513 gfc_add_block_to_block (block, &se.post);
2514 }
2515
2516 if (clauses->dist_sched_kind != OMP_SCHED_NONE)
2517 {
2518 c = build_omp_clause (where.lb->location, OMP_CLAUSE_DIST_SCHEDULE);
2519 OMP_CLAUSE_DIST_SCHEDULE_CHUNK_EXPR (c) = chunk_size;
2520 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2521 }
2522
41dbbb37
TS		 2523 if (clauses->async)
2524 {
2525 c = build_omp_clause (where.lb->location, OMP_CLAUSE_ASYNC);
2526 if (clauses->async_expr)
2527 OMP_CLAUSE_ASYNC_EXPR (c)
2528 = gfc_convert_expr_to_tree (block, clauses->async_expr);
2529 else
2530 OMP_CLAUSE_ASYNC_EXPR (c) = NULL;
2531 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2532 }
2533 if (clauses->seq)
2534 {
7a5e4956
CP		 2535 c = build_omp_clause (where.lb->location, OMP_CLAUSE_SEQ);
2536 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2537 }
2538 if (clauses->par_auto)
2539 {
2540 c = build_omp_clause (where.lb->location, OMP_CLAUSE_AUTO);
41dbbb37
TS		 2541 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2542 }
2543 if (clauses->independent)
2544 {
2545 c = build_omp_clause (where.lb->location, OMP_CLAUSE_INDEPENDENT);
2546 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2547 }
2548 if (clauses->wait_list)
2549 {
2550 gfc_expr_list *el;
2551
2552 for (el = clauses->wait_list; el; el = el->next)
2553 {
2554 c = build_omp_clause (where.lb->location, OMP_CLAUSE_WAIT);
2555 OMP_CLAUSE_DECL (c) = gfc_convert_expr_to_tree (block, el->expr);
2556 OMP_CLAUSE_CHAIN (c) = omp_clauses;
2557 omp_clauses = c;
2558 }
2559 }
2560 if (clauses->num_gangs_expr)
2561 {
2562 tree num_gangs_var
2563 = gfc_convert_expr_to_tree (block, clauses->num_gangs_expr);
2564 c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_GANGS);
2565 OMP_CLAUSE_NUM_GANGS_EXPR (c) = num_gangs_var;
2566 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2567 }
2568 if (clauses->num_workers_expr)
2569 {
2570 tree num_workers_var
2571 = gfc_convert_expr_to_tree (block, clauses->num_workers_expr);
2572 c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_WORKERS);
2573 OMP_CLAUSE_NUM_WORKERS_EXPR (c) = num_workers_var;
2574 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2575 }
2576 if (clauses->vector_length_expr)
2577 {
2578 tree vector_length_var
2579 = gfc_convert_expr_to_tree (block, clauses->vector_length_expr);
2580 c = build_omp_clause (where.lb->location, OMP_CLAUSE_VECTOR_LENGTH);
2581 OMP_CLAUSE_VECTOR_LENGTH_EXPR (c) = vector_length_var;
2582 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2583 }
7a5e4956
CP		 2584 if (clauses->tile_list)
2585 {
2586 vec<tree, va_gc> *tvec;
2587 gfc_expr_list *el;
2588
2589 vec_alloc (tvec, 4);
2590
2591 for (el = clauses->tile_list; el; el = el->next)
2592 vec_safe_push (tvec, gfc_convert_expr_to_tree (block, el->expr));
2593
2594 c = build_omp_clause (where.lb->location, OMP_CLAUSE_TILE);
2595 OMP_CLAUSE_TILE_LIST (c) = build_tree_list_vec (tvec);
2596 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2597 tvec->truncate (0);
2598 }
41dbbb37
TS		 2599 if (clauses->vector)
2600 {
2601 if (clauses->vector_expr)
2602 {
2603 tree vector_var
2604 = gfc_convert_expr_to_tree (block, clauses->vector_expr);
2605 c = build_omp_clause (where.lb->location, OMP_CLAUSE_VECTOR);
2606 OMP_CLAUSE_VECTOR_EXPR (c) = vector_var;
2607 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2608 }
2609 else
2610 {
2611 c = build_omp_clause (where.lb->location, OMP_CLAUSE_VECTOR);
2612 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2613 }
2614 }
2615 if (clauses->worker)
2616 {
2617 if (clauses->worker_expr)
2618 {
2619 tree worker_var
2620 = gfc_convert_expr_to_tree (block, clauses->worker_expr);
2621 c = build_omp_clause (where.lb->location, OMP_CLAUSE_WORKER);
2622 OMP_CLAUSE_WORKER_EXPR (c) = worker_var;
2623 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2624 }
2625 else
2626 {
2627 c = build_omp_clause (where.lb->location, OMP_CLAUSE_WORKER);
2628 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2629 }
2630 }
2631 if (clauses->gang)
2632 {
2a70708e
CP		 2633 tree arg;
2634 c = build_omp_clause (where.lb->location, OMP_CLAUSE_GANG);
2635 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2636 if (clauses->gang_num_expr)
7a5e4956 2637 {
2a70708e
CP		 2638 arg = gfc_convert_expr_to_tree (block, clauses->gang_num_expr);
2639 OMP_CLAUSE_GANG_EXPR (c) = arg;
41dbbb37 2640 }
2a70708e 2641 if (clauses->gang_static)
41dbbb37 2642 {
2a70708e
CP		 2643 arg = clauses->gang_static_expr
2644 ? gfc_convert_expr_to_tree (block, clauses->gang_static_expr)
2645 : integer_minus_one_node;
2646 OMP_CLAUSE_GANG_STATIC_EXPR (c) = arg;
41dbbb37
TS		 2647 }
2648 }
2649
f014c653 2650 return nreverse (omp_clauses);
6c7a4dfd
JJ		 2651}
2652
2653/* Like gfc_trans_code, but force creation of a BIND_EXPR around it. */
2654
2655static tree
2656gfc_trans_omp_code (gfc_code *code, bool force_empty)
2657{
2658 tree stmt;
2659
87a60f68 2660 pushlevel ();
6c7a4dfd
JJ		 2661 stmt = gfc_trans_code (code);
2662 if (TREE_CODE (stmt) != BIND_EXPR)
2663 {
2664 if (!IS_EMPTY_STMT (stmt) || force_empty)
2665 {
87a60f68 2666 tree block = poplevel (1, 0);
6c7a4dfd
JJ		 2667 stmt = build3_v (BIND_EXPR, NULL, stmt, block);
2668 }
2669 else
87a60f68 2670 poplevel (0, 0);
6c7a4dfd
JJ		 2671 }
2672 else
87a60f68 2673 poplevel (0, 0);
6c7a4dfd
JJ		 2674 return stmt;
2675}
2676
41dbbb37
TS		 2677/* Trans OpenACC directives. */
2678/* parallel, kernels, data and host_data. */
2679static tree
2680gfc_trans_oacc_construct (gfc_code *code)
2681{
2682 stmtblock_t block;
2683 tree stmt, oacc_clauses;
2684 enum tree_code construct_code;
2685
2686 switch (code->op)
2687 {
2688 case EXEC_OACC_PARALLEL:
2689 construct_code = OACC_PARALLEL;
2690 break;
2691 case EXEC_OACC_KERNELS:
2692 construct_code = OACC_KERNELS;
2693 break;
2694 case EXEC_OACC_DATA:
2695 construct_code = OACC_DATA;
2696 break;
2697 case EXEC_OACC_HOST_DATA:
2698 construct_code = OACC_HOST_DATA;
2699 break;
2700 default:
2701 gcc_unreachable ();
2702 }
2703
2704 gfc_start_block (&block);
2705 oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
2706 code->loc);
2707 stmt = gfc_trans_omp_code (code->block->next, true);
2708 stmt = build2_loc (input_location, construct_code, void_type_node, stmt,
2709 oacc_clauses);
2710 gfc_add_expr_to_block (&block, stmt);
2711 return gfc_finish_block (&block);
2712}
2713
2714/* update, enter_data, exit_data, cache. */
2715static tree
2716gfc_trans_oacc_executable_directive (gfc_code *code)
2717{
2718 stmtblock_t block;
2719 tree stmt, oacc_clauses;
2720 enum tree_code construct_code;
2721
2722 switch (code->op)
2723 {
2724 case EXEC_OACC_UPDATE:
2725 construct_code = OACC_UPDATE;
2726 break;
2727 case EXEC_OACC_ENTER_DATA:
2728 construct_code = OACC_ENTER_DATA;
2729 break;
2730 case EXEC_OACC_EXIT_DATA:
2731 construct_code = OACC_EXIT_DATA;
2732 break;
2733 case EXEC_OACC_CACHE:
2734 construct_code = OACC_CACHE;
2735 break;
2736 default:
2737 gcc_unreachable ();
2738 }
2739
2740 gfc_start_block (&block);
2741 oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
2742 code->loc);
2743 stmt = build1_loc (input_location, construct_code, void_type_node,
2744 oacc_clauses);
2745 gfc_add_expr_to_block (&block, stmt);
2746 return gfc_finish_block (&block);
2747}
2748
2749static tree
2750gfc_trans_oacc_wait_directive (gfc_code *code)
2751{
2752 stmtblock_t block;
2753 tree stmt, t;
2754 vec<tree, va_gc> *args;
2755 int nparms = 0;
2756 gfc_expr_list *el;
2757 gfc_omp_clauses *clauses = code->ext.omp_clauses;
2758 location_t loc = input_location;
2759
2760 for (el = clauses->wait_list; el; el = el->next)
2761 nparms++;
2762
2763 vec_alloc (args, nparms + 2);
2764 stmt = builtin_decl_explicit (BUILT_IN_GOACC_WAIT);
2765
2766 gfc_start_block (&block);
2767
2768 if (clauses->async_expr)
2769 t = gfc_convert_expr_to_tree (&block, clauses->async_expr);
2770 else
2771 t = build_int_cst (integer_type_node, -2);
2772
2773 args->quick_push (t);
2774 args->quick_push (build_int_cst (integer_type_node, nparms));
2775
2776 for (el = clauses->wait_list; el; el = el->next)
2777 args->quick_push (gfc_convert_expr_to_tree (&block, el->expr));
2778
2779 stmt = build_call_expr_loc_vec (loc, stmt, args);
2780 gfc_add_expr_to_block (&block, stmt);
2781
2782 vec_free (args);
2783
2784 return gfc_finish_block (&block);
2785}
6c7a4dfd
JJ		 2786
2787static tree gfc_trans_omp_sections (gfc_code *, gfc_omp_clauses *);
2788static tree gfc_trans_omp_workshare (gfc_code *, gfc_omp_clauses *);
2789
2790static tree
2791gfc_trans_omp_atomic (gfc_code *code)
2792{
20906c66 2793 gfc_code *atomic_code = code;
6c7a4dfd
JJ		 2794 gfc_se lse;
2795 gfc_se rse;
20906c66 2796 gfc_se vse;
6c7a4dfd
JJ		 2797 gfc_expr *expr2, *e;
2798 gfc_symbol *var;
2799 stmtblock_t block;
2800 tree lhsaddr, type, rhs, x;
2801 enum tree_code op = ERROR_MARK;
20906c66 2802 enum tree_code aop = OMP_ATOMIC;
6c7a4dfd 2803 bool var_on_left = false;
dd2fc525 2804 bool seq_cst = (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SEQ_CST) != 0;
6c7a4dfd
JJ		 2805
2806 code = code->block->next;
2807 gcc_assert (code->op == EXEC_ASSIGN);
a513927a 2808 var = code->expr1->symtree->n.sym;
6c7a4dfd
JJ		 2809
2810 gfc_init_se (&lse, NULL);
2811 gfc_init_se (&rse, NULL);
20906c66 2812 gfc_init_se (&vse, NULL);
6c7a4dfd
JJ		 2813 gfc_start_block (&block);
2814
6c7a4dfd
JJ		 2815 expr2 = code->expr2;
2816 if (expr2->expr_type == EXPR_FUNCTION
cd5ecab6 2817 && expr2->value.function.isym->id == GFC_ISYM_CONVERSION)
6c7a4dfd
JJ		 2818 expr2 = expr2->value.function.actual->expr;
2819
dd2fc525 2820 switch (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK)
20906c66
JJ		 2821 {
2822 case GFC_OMP_ATOMIC_READ:
2823 gfc_conv_expr (&vse, code->expr1);
2824 gfc_add_block_to_block (&block, &vse.pre);
2825
2826 gfc_conv_expr (&lse, expr2);
2827 gfc_add_block_to_block (&block, &lse.pre);
2828 type = TREE_TYPE (lse.expr);
2829 lhsaddr = gfc_build_addr_expr (NULL, lse.expr);
2830
2831 x = build1 (OMP_ATOMIC_READ, type, lhsaddr);
dd2fc525 2832 OMP_ATOMIC_SEQ_CST (x) = seq_cst;
20906c66
JJ		 2833 x = convert (TREE_TYPE (vse.expr), x);
2834 gfc_add_modify (&block, vse.expr, x);
2835
2836 gfc_add_block_to_block (&block, &lse.pre);
2837 gfc_add_block_to_block (&block, &rse.pre);
2838
2839 return gfc_finish_block (&block);
2840 case GFC_OMP_ATOMIC_CAPTURE:
2841 aop = OMP_ATOMIC_CAPTURE_NEW;
2842 if (expr2->expr_type == EXPR_VARIABLE)
2843 {
2844 aop = OMP_ATOMIC_CAPTURE_OLD;
2845 gfc_conv_expr (&vse, code->expr1);
2846 gfc_add_block_to_block (&block, &vse.pre);
2847
2848 gfc_conv_expr (&lse, expr2);
2849 gfc_add_block_to_block (&block, &lse.pre);
2850 gfc_init_se (&lse, NULL);
2851 code = code->next;
2852 var = code->expr1->symtree->n.sym;
2853 expr2 = code->expr2;
2854 if (expr2->expr_type == EXPR_FUNCTION
2855 && expr2->value.function.isym->id == GFC_ISYM_CONVERSION)
2856 expr2 = expr2->value.function.actual->expr;
2857 }
2858 break;
2859 default:
2860 break;
2861 }
2862
2863 gfc_conv_expr (&lse, code->expr1);
2864 gfc_add_block_to_block (&block, &lse.pre);
2865 type = TREE_TYPE (lse.expr);
2866 lhsaddr = gfc_build_addr_expr (NULL, lse.expr);
2867
dd2fc525
JJ		 2868 if (((atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK)
2869 == GFC_OMP_ATOMIC_WRITE)
2870 || (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SWAP))
20906c66
JJ		 2871 {
2872 gfc_conv_expr (&rse, expr2);
2873 gfc_add_block_to_block (&block, &rse.pre);
2874 }
2875 else if (expr2->expr_type == EXPR_OP)
6c7a4dfd
JJ		 2876 {
2877 gfc_expr *e;
a1ee985f 2878 switch (expr2->value.op.op)
6c7a4dfd
JJ		 2879 {
2880 case INTRINSIC_PLUS:
2881 op = PLUS_EXPR;
2882 break;
2883 case INTRINSIC_TIMES:
2884 op = MULT_EXPR;
2885 break;
2886 case INTRINSIC_MINUS:
2887 op = MINUS_EXPR;
2888 break;
2889 case INTRINSIC_DIVIDE:
2890 if (expr2->ts.type == BT_INTEGER)
2891 op = TRUNC_DIV_EXPR;
2892 else
2893 op = RDIV_EXPR;
2894 break;
2895 case INTRINSIC_AND:
2896 op = TRUTH_ANDIF_EXPR;
2897 break;
2898 case INTRINSIC_OR:
2899 op = TRUTH_ORIF_EXPR;
2900 break;
2901 case INTRINSIC_EQV:
2902 op = EQ_EXPR;
2903 break;
2904 case INTRINSIC_NEQV:
2905 op = NE_EXPR;
2906 break;
2907 default:
2908 gcc_unreachable ();
2909 }
2910 e = expr2->value.op.op1;
2911 if (e->expr_type == EXPR_FUNCTION
cd5ecab6 2912 && e->value.function.isym->id == GFC_ISYM_CONVERSION)
6c7a4dfd
JJ		 2913 e = e->value.function.actual->expr;
2914 if (e->expr_type == EXPR_VARIABLE
2915 && e->symtree != NULL
2916 && e->symtree->n.sym == var)
2917 {
2918 expr2 = expr2->value.op.op2;
2919 var_on_left = true;
2920 }
2921 else
2922 {
2923 e = expr2->value.op.op2;
2924 if (e->expr_type == EXPR_FUNCTION
cd5ecab6 2925 && e->value.function.isym->id == GFC_ISYM_CONVERSION)
6c7a4dfd
JJ		 2926 e = e->value.function.actual->expr;
2927 gcc_assert (e->expr_type == EXPR_VARIABLE
2928 && e->symtree != NULL
2929 && e->symtree->n.sym == var);
2930 expr2 = expr2->value.op.op1;
2931 var_on_left = false;
2932 }
2933 gfc_conv_expr (&rse, expr2);
2934 gfc_add_block_to_block (&block, &rse.pre);
2935 }
2936 else
2937 {
2938 gcc_assert (expr2->expr_type == EXPR_FUNCTION);
cd5ecab6 2939 switch (expr2->value.function.isym->id)
6c7a4dfd
JJ		 2940 {
2941 case GFC_ISYM_MIN:
2942 op = MIN_EXPR;
2943 break;
2944 case GFC_ISYM_MAX:
2945 op = MAX_EXPR;
2946 break;
2947 case GFC_ISYM_IAND:
2948 op = BIT_AND_EXPR;
2949 break;
2950 case GFC_ISYM_IOR:
2951 op = BIT_IOR_EXPR;
2952 break;
2953 case GFC_ISYM_IEOR:
2954 op = BIT_XOR_EXPR;
2955 break;
2956 default:
2957 gcc_unreachable ();
2958 }
2959 e = expr2->value.function.actual->expr;
2960 gcc_assert (e->expr_type == EXPR_VARIABLE
2961 && e->symtree != NULL
2962 && e->symtree->n.sym == var);
2963
2964 gfc_conv_expr (&rse, expr2->value.function.actual->next->expr);
2965 gfc_add_block_to_block (&block, &rse.pre);
2966 if (expr2->value.function.actual->next->next != NULL)
2967 {
2968 tree accum = gfc_create_var (TREE_TYPE (rse.expr), NULL);
2969 gfc_actual_arglist *arg;
2970
726a989a 2971 gfc_add_modify (&block, accum, rse.expr);
6c7a4dfd
JJ		 2972 for (arg = expr2->value.function.actual->next->next; arg;
2973 arg = arg->next)
2974 {
2975 gfc_init_block (&rse.pre);
2976 gfc_conv_expr (&rse, arg->expr);
2977 gfc_add_block_to_block (&block, &rse.pre);
65a9ca82
TB		 2978 x = fold_build2_loc (input_location, op, TREE_TYPE (accum),
2979 accum, rse.expr);
726a989a 2980 gfc_add_modify (&block, accum, x);
6c7a4dfd
JJ		 2981 }
2982
2983 rse.expr = accum;
2984 }
2985
2986 expr2 = expr2->value.function.actual->next->expr;
2987 }
2988
2989 lhsaddr = save_expr (lhsaddr);
3f9e8f13
JJ		 2990 if (TREE_CODE (lhsaddr) != SAVE_EXPR
2991 && (TREE_CODE (lhsaddr) != ADDR_EXPR
2992 || TREE_CODE (TREE_OPERAND (lhsaddr, 0)) != VAR_DECL))
2993 {
2994 /* Make sure LHS is simple enough so that goa_lhs_expr_p can recognize
2995 it even after unsharing function body. */
b731b390 2996 tree var = create_tmp_var_raw (TREE_TYPE (lhsaddr));
3f9e8f13
JJ		 2997 DECL_CONTEXT (var) = current_function_decl;
2998 lhsaddr = build4 (TARGET_EXPR, TREE_TYPE (lhsaddr), var, lhsaddr,
2999 NULL_TREE, NULL_TREE);
3000 }
3001
6c7a4dfd 3002 rhs = gfc_evaluate_now (rse.expr, &block);
6c7a4dfd 3003
dd2fc525
JJ		 3004 if (((atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK)
3005 == GFC_OMP_ATOMIC_WRITE)
3006 || (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SWAP))
20906c66 3007 x = rhs;
6c7a4dfd 3008 else
20906c66
JJ		 3009 {
3010 x = convert (TREE_TYPE (rhs),
3011 build_fold_indirect_ref_loc (input_location, lhsaddr));
3012 if (var_on_left)
3013 x = fold_build2_loc (input_location, op, TREE_TYPE (rhs), x, rhs);
3014 else
3015 x = fold_build2_loc (input_location, op, TREE_TYPE (rhs), rhs, x);
3016 }
6c7a4dfd
JJ		 3017
3018 if (TREE_CODE (TREE_TYPE (rhs)) == COMPLEX_TYPE
3019 && TREE_CODE (type) != COMPLEX_TYPE)
65a9ca82
TB		 3020 x = fold_build1_loc (input_location, REALPART_EXPR,
3021 TREE_TYPE (TREE_TYPE (rhs)), x);
6c7a4dfd 3022
6c7a4dfd
JJ		 3023 gfc_add_block_to_block (&block, &lse.pre);
3024 gfc_add_block_to_block (&block, &rse.pre);
3025
20906c66
JJ		 3026 if (aop == OMP_ATOMIC)
3027 {
3028 x = build2_v (OMP_ATOMIC, lhsaddr, convert (type, x));
dd2fc525 3029 OMP_ATOMIC_SEQ_CST (x) = seq_cst;
20906c66
JJ		 3030 gfc_add_expr_to_block (&block, x);
3031 }
3032 else
3033 {
3034 if (aop == OMP_ATOMIC_CAPTURE_NEW)
3035 {
3036 code = code->next;
3037 expr2 = code->expr2;
3038 if (expr2->expr_type == EXPR_FUNCTION
3039 && expr2->value.function.isym->id == GFC_ISYM_CONVERSION)
3040 expr2 = expr2->value.function.actual->expr;
3041
3042 gcc_assert (expr2->expr_type == EXPR_VARIABLE);
3043 gfc_conv_expr (&vse, code->expr1);
3044 gfc_add_block_to_block (&block, &vse.pre);
3045
3046 gfc_init_se (&lse, NULL);
3047 gfc_conv_expr (&lse, expr2);
3048 gfc_add_block_to_block (&block, &lse.pre);
3049 }
3050 x = build2 (aop, type, lhsaddr, convert (type, x));
dd2fc525 3051 OMP_ATOMIC_SEQ_CST (x) = seq_cst;
20906c66
JJ		 3052 x = convert (TREE_TYPE (vse.expr), x);
3053 gfc_add_modify (&block, vse.expr, x);
3054 }
3055
6c7a4dfd
JJ		 3056 return gfc_finish_block (&block);
3057}
3058
3059static tree
3060gfc_trans_omp_barrier (void)
3061{
e79983f4 3062 tree decl = builtin_decl_explicit (BUILT_IN_GOMP_BARRIER);
db3927fb 3063 return build_call_expr_loc (input_location, decl, 0);
6c7a4dfd
JJ		 3064}
3065
dd2fc525
JJ		 3066static tree
3067gfc_trans_omp_cancel (gfc_code *code)
3068{
3069 int mask = 0;
3070 tree ifc = boolean_true_node;
3071 stmtblock_t block;
3072 switch (code->ext.omp_clauses->cancel)
3073 {
3074 case OMP_CANCEL_PARALLEL: mask = 1; break;
3075 case OMP_CANCEL_DO: mask = 2; break;
3076 case OMP_CANCEL_SECTIONS: mask = 4; break;
3077 case OMP_CANCEL_TASKGROUP: mask = 8; break;
3078 default: gcc_unreachable ();
3079 }
3080 gfc_start_block (&block);
3081 if (code->ext.omp_clauses->if_expr)
3082 {
3083 gfc_se se;
3084 tree if_var;
3085
3086 gfc_init_se (&se, NULL);
3087 gfc_conv_expr (&se, code->ext.omp_clauses->if_expr);
3088 gfc_add_block_to_block (&block, &se.pre);
3089 if_var = gfc_evaluate_now (se.expr, &block);
3090 gfc_add_block_to_block (&block, &se.post);
3091 tree type = TREE_TYPE (if_var);
3092 ifc = fold_build2_loc (input_location, NE_EXPR,
3093 boolean_type_node, if_var,
3094 build_zero_cst (type));
3095 }
3096 tree decl = builtin_decl_explicit (BUILT_IN_GOMP_CANCEL);
3097 tree c_bool_type = TREE_TYPE (TREE_TYPE (decl));
3098 ifc = fold_convert (c_bool_type, ifc);
3099 gfc_add_expr_to_block (&block,
3100 build_call_expr_loc (input_location, decl, 2,
3101 build_int_cst (integer_type_node,
3102 mask), ifc));
3103 return gfc_finish_block (&block);
3104}
3105
3106static tree
3107gfc_trans_omp_cancellation_point (gfc_code *code)
3108{
3109 int mask = 0;
3110 switch (code->ext.omp_clauses->cancel)
3111 {
3112 case OMP_CANCEL_PARALLEL: mask = 1; break;
3113 case OMP_CANCEL_DO: mask = 2; break;
3114 case OMP_CANCEL_SECTIONS: mask = 4; break;
3115 case OMP_CANCEL_TASKGROUP: mask = 8; break;
3116 default: gcc_unreachable ();
3117 }
3118 tree decl = builtin_decl_explicit (BUILT_IN_GOMP_CANCELLATION_POINT);
3119 return build_call_expr_loc (input_location, decl, 1,
3120 build_int_cst (integer_type_node, mask));
3121}
3122
6c7a4dfd
JJ		 3123static tree
3124gfc_trans_omp_critical (gfc_code *code)
3125{
3126 tree name = NULL_TREE, stmt;
3127 if (code->ext.omp_name != NULL)
3128 name = get_identifier (code->ext.omp_name);
3129 stmt = gfc_trans_code (code->block->next);
d9a6bd32
JJ		 3130 return build3_loc (input_location, OMP_CRITICAL, void_type_node, stmt,
3131 NULL_TREE, name);
6c7a4dfd
JJ		 3132}
3133
04924d6a
NF		 3134typedef struct dovar_init_d {
3135 tree var;
3136 tree init;
3137} dovar_init;
3138
04924d6a 3139
6c7a4dfd 3140static tree
dd2fc525 3141gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
a68ab351 3142 gfc_omp_clauses *do_clauses, tree par_clauses)
6c7a4dfd
JJ		 3143{
3144 gfc_se se;
3145 tree dovar, stmt, from, to, step, type, init, cond, incr;
3146 tree count = NULL_TREE, cycle_label, tmp, omp_clauses;
3147 stmtblock_t block;
3148 stmtblock_t body;
742fae05 3149 gfc_omp_clauses *clauses = code->ext.omp_clauses;
a68ab351 3150 int i, collapse = clauses->collapse;
6e1aa848 3151 vec<dovar_init> inits = vNULL;
04924d6a
NF		 3152 dovar_init *di;
3153 unsigned ix;
6c7a4dfd 3154
a68ab351
JJ		 3155 if (collapse <= 0)
3156 collapse = 1;
3157
c4fae39e 3158 code = code->block->next;
6c7a4dfd
JJ		 3159 gcc_assert (code->op == EXEC_DO);
3160
a68ab351
JJ		 3161 init = make_tree_vec (collapse);
3162 cond = make_tree_vec (collapse);
3163 incr = make_tree_vec (collapse);
3164
6c7a4dfd
JJ		 3165 if (pblock == NULL)
3166 {
3167 gfc_start_block (&block);
3168 pblock = &block;
3169 }
3170
742fae05 3171 omp_clauses = gfc_trans_omp_clauses (pblock, do_clauses, code->loc);
6c7a4dfd 3172
a68ab351 3173 for (i = 0; i < collapse; i++)
6c7a4dfd 3174 {
a68ab351
JJ		 3175 int simple = 0;
3176 int dovar_found = 0;
281e33e1 3177 tree dovar_decl;
a68ab351
JJ		 3178
3179 if (clauses)
6c7a4dfd 3180 {
f014c653
JJ		 3181 gfc_omp_namelist *n = NULL;
3182 if (op != EXEC_OMP_DISTRIBUTE)
3183 for (n = clauses->lists[(op == EXEC_OMP_SIMD && collapse == 1)
3184 ? OMP_LIST_LINEAR : OMP_LIST_LASTPRIVATE];
3185 n != NULL; n = n->next)
3186 if (code->ext.iterator->var->symtree->n.sym == n->sym)
3187 break;
a68ab351
JJ		 3188 if (n != NULL)
3189 dovar_found = 1;
dd2fc525 3190 else if (n == NULL && op != EXEC_OMP_SIMD)
a68ab351
JJ		 3191 for (n = clauses->lists[OMP_LIST_PRIVATE]; n != NULL; n = n->next)
3192 if (code->ext.iterator->var->symtree->n.sym == n->sym)
3193 break;
3194 if (n != NULL)
3195 dovar_found++;
6c7a4dfd 3196 }
a68ab351
JJ		 3197
3198 /* Evaluate all the expressions in the iterator. */
3199 gfc_init_se (&se, NULL);
3200 gfc_conv_expr_lhs (&se, code->ext.iterator->var);
3201 gfc_add_block_to_block (pblock, &se.pre);
3202 dovar = se.expr;
3203 type = TREE_TYPE (dovar);
3204 gcc_assert (TREE_CODE (type) == INTEGER_TYPE);
3205
3206 gfc_init_se (&se, NULL);
3207 gfc_conv_expr_val (&se, code->ext.iterator->start);
3208 gfc_add_block_to_block (pblock, &se.pre);
3209 from = gfc_evaluate_now (se.expr, pblock);
3210
3211 gfc_init_se (&se, NULL);
3212 gfc_conv_expr_val (&se, code->ext.iterator->end);
3213 gfc_add_block_to_block (pblock, &se.pre);
3214 to = gfc_evaluate_now (se.expr, pblock);
3215
3216 gfc_init_se (&se, NULL);
3217 gfc_conv_expr_val (&se, code->ext.iterator->step);
3218 gfc_add_block_to_block (pblock, &se.pre);
3219 step = gfc_evaluate_now (se.expr, pblock);
281e33e1 3220 dovar_decl = dovar;
a68ab351
JJ		 3221
3222 /* Special case simple loops. */
281e33e1
JJ		 3223 if (TREE_CODE (dovar) == VAR_DECL)
3224 {
3225 if (integer_onep (step))
3226 simple = 1;
3227 else if (tree_int_cst_equal (step, integer_minus_one_node))
3228 simple = -1;
3229 }
3230 else
3231 dovar_decl
dd2fc525
JJ		 3232 = gfc_trans_omp_variable (code->ext.iterator->var->symtree->n.sym,
3233 false);
a68ab351
JJ		 3234
3235 /* Loop body. */
3236 if (simple)
6c7a4dfd 3237 {
726a989a 3238 TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, dovar, from);
edaadf74
JJ		 3239 /* The condition should not be folded. */
3240 TREE_VEC_ELT (cond, i) = build2_loc (input_location, simple > 0
3241 ? LE_EXPR : GE_EXPR,
3242 boolean_type_node, dovar, to);
65a9ca82
TB		 3243 TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR,
3244 type, dovar, step);
3245 TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location,
3246 MODIFY_EXPR,
3247 type, dovar,
3248 TREE_VEC_ELT (incr, i));
a68ab351
JJ		 3249 }
3250 else
3251 {
3252 /* STEP is not 1 or -1. Use:
3253 for (count = 0; count < (to + step - from) / step; count++)
3254 {
3255 dovar = from + count * step;
3256 body;
3257 cycle_label:;
3258 } */
65a9ca82
TB		 3259 tmp = fold_build2_loc (input_location, MINUS_EXPR, type, step, from);
3260 tmp = fold_build2_loc (input_location, PLUS_EXPR, type, to, tmp);
3261 tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR, type, tmp,
3262 step);
a68ab351
JJ		 3263 tmp = gfc_evaluate_now (tmp, pblock);
3264 count = gfc_create_var (type, "count");
726a989a 3265 TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, count,
a68ab351 3266 build_int_cst (type, 0));
edaadf74
JJ		 3267 /* The condition should not be folded. */
3268 TREE_VEC_ELT (cond, i) = build2_loc (input_location, LT_EXPR,
3269 boolean_type_node,
3270 count, tmp);
65a9ca82
TB		 3271 TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR,
3272 type, count,
3273 build_int_cst (type, 1));
3274 TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location,
3275 MODIFY_EXPR, type, count,
3276 TREE_VEC_ELT (incr, i));
a68ab351
JJ		 3277
3278 /* Initialize DOVAR. */
65a9ca82
TB		 3279 tmp = fold_build2_loc (input_location, MULT_EXPR, type, count, step);
3280 tmp = fold_build2_loc (input_location, PLUS_EXPR, type, from, tmp);
f32682ca 3281 dovar_init e = {dovar, tmp};
9771b263 3282 inits.safe_push (e);
6c7a4dfd 3283 }
6c7a4dfd 3284
6c384511
JJ		 3285 if (dovar_found == 2
3286 && op == EXEC_OMP_SIMD
3287 && collapse == 1
3288 && !simple)
3289 {
3290 for (tmp = omp_clauses; tmp; tmp = OMP_CLAUSE_CHAIN (tmp))
3291 if (OMP_CLAUSE_CODE (tmp) == OMP_CLAUSE_LINEAR
3292 && OMP_CLAUSE_DECL (tmp) == dovar)
3293 {
3294 OMP_CLAUSE_LINEAR_NO_COPYIN (tmp) = 1;
3295 break;
3296 }
3297 }
a68ab351
JJ		 3298 if (!dovar_found)
3299 {
dd2fc525
JJ		 3300 if (op == EXEC_OMP_SIMD)
3301 {
3302 if (collapse == 1)
3303 {
3304 tmp = build_omp_clause (input_location, OMP_CLAUSE_LINEAR);
3305 OMP_CLAUSE_LINEAR_STEP (tmp) = step;
6c384511 3306 OMP_CLAUSE_LINEAR_NO_COPYIN (tmp) = 1;
dd2fc525
JJ		 3307 }
3308 else
3309 tmp = build_omp_clause (input_location, OMP_CLAUSE_LASTPRIVATE);
3310 if (!simple)
3311 dovar_found = 2;
3312 }
3313 else
3314 tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE);
281e33e1 3315 OMP_CLAUSE_DECL (tmp) = dovar_decl;
a68ab351
JJ		 3316 omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
3317 }
dd2fc525 3318 if (dovar_found == 2)
a68ab351
JJ		 3319 {
3320 tree c = NULL;
3321
3322 tmp = NULL;
3323 if (!simple)
3324 {
3325 /* If dovar is lastprivate, but different counter is used,
3326 dovar += step needs to be added to
3327 OMP_CLAUSE_LASTPRIVATE_STMT, otherwise the copied dovar
3328 will have the value on entry of the last loop, rather
3329 than value after iterator increment. */
3330 tmp = gfc_evaluate_now (step, pblock);
65a9ca82
TB		 3331 tmp = fold_build2_loc (input_location, PLUS_EXPR, type, dovar,
3332 tmp);
3333 tmp = fold_build2_loc (input_location, MODIFY_EXPR, type,
3334 dovar, tmp);
a68ab351
JJ		 3335 for (c = omp_clauses; c ; c = OMP_CLAUSE_CHAIN (c))
3336 if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE
281e33e1 3337 && OMP_CLAUSE_DECL (c) == dovar_decl)
a68ab351
JJ		 3338 {
3339 OMP_CLAUSE_LASTPRIVATE_STMT (c) = tmp;
3340 break;
3341 }
dd2fc525
JJ		 3342 else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LINEAR
3343 && OMP_CLAUSE_DECL (c) == dovar_decl)
3344 {
3345 OMP_CLAUSE_LINEAR_STMT (c) = tmp;
3346 break;
3347 }
a68ab351 3348 }
dd2fc525 3349 if (c == NULL && op == EXEC_OMP_DO && par_clauses != NULL)
a68ab351
JJ		 3350 {
3351 for (c = par_clauses; c ; c = OMP_CLAUSE_CHAIN (c))
3352 if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE
281e33e1 3353 && OMP_CLAUSE_DECL (c) == dovar_decl)
a68ab351 3354 {
c2255bc4
AH		 3355 tree l = build_omp_clause (input_location,
3356 OMP_CLAUSE_LASTPRIVATE);
281e33e1 3357 OMP_CLAUSE_DECL (l) = dovar_decl;
a68ab351
JJ		 3358 OMP_CLAUSE_CHAIN (l) = omp_clauses;
3359 OMP_CLAUSE_LASTPRIVATE_STMT (l) = tmp;
3360 omp_clauses = l;
3361 OMP_CLAUSE_SET_CODE (c, OMP_CLAUSE_SHARED);
3362 break;
3363 }
3364 }
3365 gcc_assert (simple || c != NULL);
3366 }
3367 if (!simple)
3368 {
dd2fc525
JJ		 3369 if (op != EXEC_OMP_SIMD)
3370 tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE);
3371 else if (collapse == 1)
3372 {
3373 tmp = build_omp_clause (input_location, OMP_CLAUSE_LINEAR);
6c384511 3374 OMP_CLAUSE_LINEAR_STEP (tmp) = build_int_cst (type, 1);
dd2fc525
JJ		 3375 OMP_CLAUSE_LINEAR_NO_COPYIN (tmp) = 1;
3376 OMP_CLAUSE_LINEAR_NO_COPYOUT (tmp) = 1;
3377 }
3378 else
3379 tmp = build_omp_clause (input_location, OMP_CLAUSE_LASTPRIVATE);
a68ab351
JJ		 3380 OMP_CLAUSE_DECL (tmp) = count;
3381 omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
3382 }
3383
3384 if (i + 1 < collapse)
3385 code = code->block->next;
6c7a4dfd
JJ		 3386 }
3387
a68ab351 3388 if (pblock != &block)
6c7a4dfd 3389 {
87a60f68 3390 pushlevel ();
a68ab351 3391 gfc_start_block (&block);
6c7a4dfd 3392 }
a68ab351
JJ		 3393
3394 gfc_start_block (&body);
3395
9771b263 3396 FOR_EACH_VEC_ELT (inits, ix, di)
04924d6a 3397 gfc_add_modify (&body, di->var, di->init);
9771b263 3398 inits.release ();
6c7a4dfd
JJ		 3399
3400 /* Cycle statement is implemented with a goto. Exit statement must not be
3401 present for this loop. */
3402 cycle_label = gfc_build_label_decl (NULL_TREE);
3403
e7041633 3404 /* Put these labels where they can be found later. */
6c7a4dfd 3405
7602cb87
JJ		 3406 code->cycle_label = cycle_label;
3407 code->exit_label = NULL_TREE;
6c7a4dfd
JJ		 3408
3409 /* Main loop body. */
3410 tmp = gfc_trans_omp_code (code->block->next, true);
3411 gfc_add_expr_to_block (&body, tmp);
3412
3413 /* Label for cycle statements (if needed). */
3414 if (TREE_USED (cycle_label))
3415 {
3416 tmp = build1_v (LABEL_EXPR, cycle_label);
3417 gfc_add_expr_to_block (&body, tmp);
3418 }
3419
3420 /* End of loop body. */
f014c653
JJ		 3421 switch (op)
3422 {
3423 case EXEC_OMP_SIMD: stmt = make_node (OMP_SIMD); break;
3424 case EXEC_OMP_DO: stmt = make_node (OMP_FOR); break;
3425 case EXEC_OMP_DISTRIBUTE: stmt = make_node (OMP_DISTRIBUTE); break;
41dbbb37 3426 case EXEC_OACC_LOOP: stmt = make_node (OACC_LOOP); break;
f014c653
JJ		 3427 default: gcc_unreachable ();
3428 }
6c7a4dfd
JJ		 3429
3430 TREE_TYPE (stmt) = void_type_node;
3431 OMP_FOR_BODY (stmt) = gfc_finish_block (&body);
3432 OMP_FOR_CLAUSES (stmt) = omp_clauses;
3433 OMP_FOR_INIT (stmt) = init;
3434 OMP_FOR_COND (stmt) = cond;
3435 OMP_FOR_INCR (stmt) = incr;
3436 gfc_add_expr_to_block (&block, stmt);
3437
3438 return gfc_finish_block (&block);
3439}
3440
41dbbb37
TS		 3441/* parallel loop and kernels loop. */
3442static tree
3443gfc_trans_oacc_combined_directive (gfc_code *code)
3444{
3445 stmtblock_t block, *pblock = NULL;
3446 gfc_omp_clauses construct_clauses, loop_clauses;
3447 tree stmt, oacc_clauses = NULL_TREE;
3448 enum tree_code construct_code;
3449
3450 switch (code->op)
3451 {
3452 case EXEC_OACC_PARALLEL_LOOP:
3453 construct_code = OACC_PARALLEL;
3454 break;
3455 case EXEC_OACC_KERNELS_LOOP:
3456 construct_code = OACC_KERNELS;
3457 break;
3458 default:
3459 gcc_unreachable ();
3460 }
3461
3462 gfc_start_block (&block);
3463
3464 memset (&loop_clauses, 0, sizeof (loop_clauses));
3465 if (code->ext.omp_clauses != NULL)
3466 {
3467 memcpy (&construct_clauses, code->ext.omp_clauses,
3468 sizeof (construct_clauses));
3469 loop_clauses.collapse = construct_clauses.collapse;
3470 loop_clauses.gang = construct_clauses.gang;
7a5e4956 3471 loop_clauses.gang_static = construct_clauses.gang_static;
2a70708e
CP		 3472 loop_clauses.gang_num_expr = construct_clauses.gang_num_expr;
3473 loop_clauses.gang_static_expr = construct_clauses.gang_static_expr;
41dbbb37 3474 loop_clauses.vector = construct_clauses.vector;
7a5e4956 3475 loop_clauses.vector_expr = construct_clauses.vector_expr;
41dbbb37 3476 loop_clauses.worker = construct_clauses.worker;
7a5e4956 3477 loop_clauses.worker_expr = construct_clauses.worker_expr;
41dbbb37 3478 loop_clauses.seq = construct_clauses.seq;
7a5e4956 3479 loop_clauses.par_auto = construct_clauses.par_auto;
41dbbb37 3480 loop_clauses.independent = construct_clauses.independent;
7a5e4956
CP		 3481 loop_clauses.tile_list = construct_clauses.tile_list;
3482 loop_clauses.lists[OMP_LIST_PRIVATE]
3483 = construct_clauses.lists[OMP_LIST_PRIVATE];
3484 loop_clauses.lists[OMP_LIST_REDUCTION]
3485 = construct_clauses.lists[OMP_LIST_REDUCTION];
41dbbb37 3486 construct_clauses.gang = false;
7a5e4956 3487 construct_clauses.gang_static = false;
2a70708e
CP		 3488 construct_clauses.gang_num_expr = NULL;
3489 construct_clauses.gang_static_expr = NULL;
41dbbb37 3490 construct_clauses.vector = false;
7a5e4956 3491 construct_clauses.vector_expr = NULL;
41dbbb37 3492 construct_clauses.worker = false;
7a5e4956 3493 construct_clauses.worker_expr = NULL;
41dbbb37 3494 construct_clauses.seq = false;
7a5e4956
CP		 3495 construct_clauses.par_auto = false;
3496 construct_clauses.independent = false;
41dbbb37 3497 construct_clauses.independent = false;
7a5e4956
CP		 3498 construct_clauses.tile_list = NULL;
3499 construct_clauses.lists[OMP_LIST_PRIVATE] = NULL;
2a70708e 3500 construct_clauses.lists[OMP_LIST_REDUCTION] = NULL;
41dbbb37
TS		 3501 oacc_clauses = gfc_trans_omp_clauses (&block, &construct_clauses,
3502 code->loc);
3503 }
3504 if (!loop_clauses.seq)
3505 pblock = &block;
3506 else
3507 pushlevel ();
c146aced 3508 stmt = gfc_trans_omp_do (code, EXEC_OACC_LOOP, pblock, &loop_clauses, NULL);
41dbbb37
TS		 3509 if (TREE_CODE (stmt) != BIND_EXPR)
3510 stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
3511 else
3512 poplevel (0, 0);
3513 stmt = build2_loc (input_location, construct_code, void_type_node, stmt,
3514 oacc_clauses);
41dbbb37
TS		 3515 gfc_add_expr_to_block (&block, stmt);
3516 return gfc_finish_block (&block);
3517}
3518
6c7a4dfd
JJ		 3519static tree
3520gfc_trans_omp_flush (void)
3521{
e79983f4 3522 tree decl = builtin_decl_explicit (BUILT_IN_SYNC_SYNCHRONIZE);
db3927fb 3523 return build_call_expr_loc (input_location, decl, 0);
6c7a4dfd
JJ		 3524}
3525
3526static tree
3527gfc_trans_omp_master (gfc_code *code)
3528{
3529 tree stmt = gfc_trans_code (code->block->next);
3530 if (IS_EMPTY_STMT (stmt))
3531 return stmt;
3532 return build1_v (OMP_MASTER, stmt);
3533}
3534
3535static tree
3536gfc_trans_omp_ordered (gfc_code *code)
3537{
d9a6bd32
JJ		 3538 return build2_loc (input_location, OMP_ORDERED, void_type_node,
3539 gfc_trans_code (code->block->next), NULL_TREE);
6c7a4dfd
JJ		 3540}
3541
3542static tree
3543gfc_trans_omp_parallel (gfc_code *code)
3544{
3545 stmtblock_t block;
3546 tree stmt, omp_clauses;
3547
3548 gfc_start_block (&block);
3549 omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
3550 code->loc);
3551 stmt = gfc_trans_omp_code (code->block->next, true);
5d44e5c8
TB		 3552 stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
3553 omp_clauses);
6c7a4dfd
JJ		 3554 gfc_add_expr_to_block (&block, stmt);
3555 return gfc_finish_block (&block);
3556}
3557
dd2fc525
JJ		 3558enum
3559{
3560 GFC_OMP_SPLIT_SIMD,
3561 GFC_OMP_SPLIT_DO,
3562 GFC_OMP_SPLIT_PARALLEL,
f014c653
JJ		 3563 GFC_OMP_SPLIT_DISTRIBUTE,
3564 GFC_OMP_SPLIT_TEAMS,
3565 GFC_OMP_SPLIT_TARGET,
dd2fc525
JJ		 3566 GFC_OMP_SPLIT_NUM
3567};
3568
3569enum
3570{
3571 GFC_OMP_MASK_SIMD = (1 << GFC_OMP_SPLIT_SIMD),
3572 GFC_OMP_MASK_DO = (1 << GFC_OMP_SPLIT_DO),
f014c653
JJ		 3573 GFC_OMP_MASK_PARALLEL = (1 << GFC_OMP_SPLIT_PARALLEL),
3574 GFC_OMP_MASK_DISTRIBUTE = (1 << GFC_OMP_SPLIT_DISTRIBUTE),
3575 GFC_OMP_MASK_TEAMS = (1 << GFC_OMP_SPLIT_TEAMS),
3576 GFC_OMP_MASK_TARGET = (1 << GFC_OMP_SPLIT_TARGET)
dd2fc525
JJ		 3577};
3578
3579static void
3580gfc_split_omp_clauses (gfc_code *code,
3581 gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM])
3582{
5f23671d 3583 int mask = 0, innermost = 0;
dd2fc525
JJ		 3584 memset (clausesa, 0, GFC_OMP_SPLIT_NUM * sizeof (gfc_omp_clauses));
3585 switch (code->op)
3586 {
f014c653
JJ		 3587 case EXEC_OMP_DISTRIBUTE:
3588 innermost = GFC_OMP_SPLIT_DISTRIBUTE;
3589 break;
3590 case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
3591 mask = GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO;
3592 innermost = GFC_OMP_SPLIT_DO;
3593 break;
3594 case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
3595 mask = GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_PARALLEL
3596 | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD;
3597 innermost = GFC_OMP_SPLIT_SIMD;
3598 break;
3599 case EXEC_OMP_DISTRIBUTE_SIMD:
3600 mask = GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD;
3601 innermost = GFC_OMP_SPLIT_SIMD;
3602 break;
3603 case EXEC_OMP_DO:
3604 innermost = GFC_OMP_SPLIT_DO;
3605 break;
dd2fc525
JJ		 3606 case EXEC_OMP_DO_SIMD:
3607 mask = GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD;
3608 innermost = GFC_OMP_SPLIT_SIMD;
3609 break;
f014c653
JJ		 3610 case EXEC_OMP_PARALLEL:
3611 innermost = GFC_OMP_SPLIT_PARALLEL;
3612 break;
dd2fc525
JJ		 3613 case EXEC_OMP_PARALLEL_DO:
3614 mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO;
3615 innermost = GFC_OMP_SPLIT_DO;
3616 break;
3617 case EXEC_OMP_PARALLEL_DO_SIMD:
3618 mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD;
3619 innermost = GFC_OMP_SPLIT_SIMD;
3620 break;
f014c653
JJ		 3621 case EXEC_OMP_SIMD:
3622 innermost = GFC_OMP_SPLIT_SIMD;
3623 break;
3624 case EXEC_OMP_TARGET:
3625 innermost = GFC_OMP_SPLIT_TARGET;
3626 break;
3627 case EXEC_OMP_TARGET_TEAMS:
3628 mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS;
3629 innermost = GFC_OMP_SPLIT_TEAMS;
3630 break;
3631 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
3632 mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS
3633 | GFC_OMP_MASK_DISTRIBUTE;
3634 innermost = GFC_OMP_SPLIT_DISTRIBUTE;
3635 break;
3636 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
3637 mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE
3638 | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO;
3639 innermost = GFC_OMP_SPLIT_DO;
3640 break;
3641 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
3642 mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE
3643 | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD;
3644 innermost = GFC_OMP_SPLIT_SIMD;
3645 break;
3646 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
3647 mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS
3648 | GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD;
3649 innermost = GFC_OMP_SPLIT_SIMD;
3650 break;
3651 case EXEC_OMP_TEAMS:
3652 innermost = GFC_OMP_SPLIT_TEAMS;
3653 break;
3654 case EXEC_OMP_TEAMS_DISTRIBUTE:
3655 mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE;
3656 innermost = GFC_OMP_SPLIT_DISTRIBUTE;
3657 break;
3658 case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
3659 mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE
3660 | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO;
3661 innermost = GFC_OMP_SPLIT_DO;
3662 break;
3663 case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
3664 mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE
3665 | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD;
3666 innermost = GFC_OMP_SPLIT_SIMD;
3667 break;
3668 case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
3669 mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD;
3670 innermost = GFC_OMP_SPLIT_SIMD;
3671 break;
dd2fc525
JJ		 3672 default:
3673 gcc_unreachable ();
3674 }
f014c653
JJ		 3675 if (mask == 0)
3676 {
3677 clausesa[innermost] = *code->ext.omp_clauses;
3678 return;
3679 }
dd2fc525
JJ		 3680 if (code->ext.omp_clauses != NULL)
3681 {
f014c653
JJ		 3682 if (mask & GFC_OMP_MASK_TARGET)
3683 {
3684 /* First the clauses that are unique to some constructs. */
3685 clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_MAP]
3686 = code->ext.omp_clauses->lists[OMP_LIST_MAP];
3687 clausesa[GFC_OMP_SPLIT_TARGET].device
3688 = code->ext.omp_clauses->device;
3689 }
3690 if (mask & GFC_OMP_MASK_TEAMS)
3691 {
3692 /* First the clauses that are unique to some constructs. */
3693 clausesa[GFC_OMP_SPLIT_TEAMS].num_teams
3694 = code->ext.omp_clauses->num_teams;
3695 clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit
3696 = code->ext.omp_clauses->thread_limit;
3697 /* Shared and default clauses are allowed on parallel and teams. */
3698 clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_SHARED]
3699 = code->ext.omp_clauses->lists[OMP_LIST_SHARED];
3700 clausesa[GFC_OMP_SPLIT_TEAMS].default_sharing
3701 = code->ext.omp_clauses->default_sharing;
3702 }
3703 if (mask & GFC_OMP_MASK_DISTRIBUTE)
3704 {
3705 /* First the clauses that are unique to some constructs. */
3706 clausesa[GFC_OMP_SPLIT_DISTRIBUTE].dist_sched_kind
3707 = code->ext.omp_clauses->dist_sched_kind;
3708 clausesa[GFC_OMP_SPLIT_DISTRIBUTE].dist_chunk_size
3709 = code->ext.omp_clauses->dist_chunk_size;
3710 /* Duplicate collapse. */
3711 clausesa[GFC_OMP_SPLIT_DISTRIBUTE].collapse
3712 = code->ext.omp_clauses->collapse;
3713 }
dd2fc525
JJ		 3714 if (mask & GFC_OMP_MASK_PARALLEL)
3715 {
3716 /* First the clauses that are unique to some constructs. */
3717 clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_COPYIN]
3718 = code->ext.omp_clauses->lists[OMP_LIST_COPYIN];
3719 clausesa[GFC_OMP_SPLIT_PARALLEL].num_threads
3720 = code->ext.omp_clauses->num_threads;
3721 clausesa[GFC_OMP_SPLIT_PARALLEL].proc_bind
3722 = code->ext.omp_clauses->proc_bind;
3723 /* Shared and default clauses are allowed on parallel and teams. */
3724 clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_SHARED]
3725 = code->ext.omp_clauses->lists[OMP_LIST_SHARED];
3726 clausesa[GFC_OMP_SPLIT_PARALLEL].default_sharing
3727 = code->ext.omp_clauses->default_sharing;
dd2fc525
JJ		 3728 }
3729 if (mask & GFC_OMP_MASK_DO)
3730 {
3731 /* First the clauses that are unique to some constructs. */
3732 clausesa[GFC_OMP_SPLIT_DO].ordered
3733 = code->ext.omp_clauses->ordered;
3734 clausesa[GFC_OMP_SPLIT_DO].sched_kind
3735 = code->ext.omp_clauses->sched_kind;
3736 clausesa[GFC_OMP_SPLIT_DO].chunk_size
3737 = code->ext.omp_clauses->chunk_size;
3738 clausesa[GFC_OMP_SPLIT_DO].nowait
3739 = code->ext.omp_clauses->nowait;
3740 /* Duplicate collapse. */
3741 clausesa[GFC_OMP_SPLIT_DO].collapse
3742 = code->ext.omp_clauses->collapse;
3743 }
3744 if (mask & GFC_OMP_MASK_SIMD)
3745 {
3746 clausesa[GFC_OMP_SPLIT_SIMD].safelen_expr
3747 = code->ext.omp_clauses->safelen_expr;
3748 clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_LINEAR]
3749 = code->ext.omp_clauses->lists[OMP_LIST_LINEAR];
3750 clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_ALIGNED]
3751 = code->ext.omp_clauses->lists[OMP_LIST_ALIGNED];
3752 /* Duplicate collapse. */
3753 clausesa[GFC_OMP_SPLIT_SIMD].collapse
3754 = code->ext.omp_clauses->collapse;
3755 }
3756 /* Private clause is supported on all constructs but target,
3757 it is enough to put it on the innermost one. For
3758 !$ omp do put it on parallel though,
3759 as that's what we did for OpenMP 3.1. */
3760 clausesa[innermost == GFC_OMP_SPLIT_DO
3761 ? (int) GFC_OMP_SPLIT_PARALLEL
3762 : innermost].lists[OMP_LIST_PRIVATE]
3763 = code->ext.omp_clauses->lists[OMP_LIST_PRIVATE];
3764 /* Firstprivate clause is supported on all constructs but
3765 target and simd. Put it on the outermost of those and
3766 duplicate on parallel. */
f014c653
JJ		 3767 if (mask & GFC_OMP_MASK_TEAMS)
3768 clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_FIRSTPRIVATE]
3769 = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
3770 else if (mask & GFC_OMP_MASK_DISTRIBUTE)
3771 clausesa[GFC_OMP_SPLIT_DISTRIBUTE].lists[OMP_LIST_FIRSTPRIVATE]
3772 = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
dd2fc525
JJ		 3773 if (mask & GFC_OMP_MASK_PARALLEL)
3774 clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_FIRSTPRIVATE]
3775 = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
3776 else if (mask & GFC_OMP_MASK_DO)
3777 clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_FIRSTPRIVATE]
3778 = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
3779 /* Lastprivate is allowed on do and simd. In
3780 parallel do{, simd} we actually want to put it on
3781 parallel rather than do. */
3782 if (mask & GFC_OMP_MASK_PARALLEL)
3783 clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_LASTPRIVATE]
3784 = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
3785 else if (mask & GFC_OMP_MASK_DO)
3786 clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_LASTPRIVATE]
3787 = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
3788 if (mask & GFC_OMP_MASK_SIMD)
3789 clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_LASTPRIVATE]
3790 = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
3791 /* Reduction is allowed on simd, do, parallel and teams.
3792 Duplicate it on all of them, but omit on do if
3793 parallel is present. */
f014c653
JJ		 3794 if (mask & GFC_OMP_MASK_TEAMS)
3795 clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_REDUCTION]
3796 = code->ext.omp_clauses->lists[OMP_LIST_REDUCTION];
5f23671d
JJ		 3797 if (mask & GFC_OMP_MASK_PARALLEL)
3798 clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_REDUCTION]
3799 = code->ext.omp_clauses->lists[OMP_LIST_REDUCTION];
3800 else if (mask & GFC_OMP_MASK_DO)
3801 clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_REDUCTION]
3802 = code->ext.omp_clauses->lists[OMP_LIST_REDUCTION];
3803 if (mask & GFC_OMP_MASK_SIMD)
3804 clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_REDUCTION]
3805 = code->ext.omp_clauses->lists[OMP_LIST_REDUCTION];
f014c653
JJ		 3806 /* FIXME: This is currently being discussed. */
3807 if (mask & GFC_OMP_MASK_PARALLEL)
3808 clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr
3809 = code->ext.omp_clauses->if_expr;
3810 else
3811 clausesa[GFC_OMP_SPLIT_TARGET].if_expr
3812 = code->ext.omp_clauses->if_expr;
dd2fc525
JJ		 3813 }
3814 if ((mask & (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO))
3815 == (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO))
3816 clausesa[GFC_OMP_SPLIT_DO].nowait = true;
3817}
3818
6c7a4dfd 3819static tree
f014c653
JJ		 3820gfc_trans_omp_do_simd (gfc_code *code, stmtblock_t *pblock,
3821 gfc_omp_clauses *clausesa, tree omp_clauses)
6c7a4dfd 3822{
f014c653 3823 stmtblock_t block;
dd2fc525
JJ		 3824 gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
3825 tree stmt, body, omp_do_clauses = NULL_TREE;
6c7a4dfd 3826
f014c653
JJ		 3827 if (pblock == NULL)
3828 gfc_start_block (&block);
3829 else
3830 gfc_init_block (&block);
6c7a4dfd 3831
dd2fc525 3832 if (clausesa == NULL)
6c7a4dfd 3833 {
dd2fc525
JJ		 3834 clausesa = clausesa_buf;
3835 gfc_split_omp_clauses (code, clausesa);
6c7a4dfd 3836 }
c61819ff 3837 if (flag_openmp)
92d28cbb
JJ		 3838 omp_do_clauses
3839 = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_DO], code->loc);
f014c653 3840 body = gfc_trans_omp_do (code, EXEC_OMP_SIMD, pblock ? pblock : &block,
dd2fc525 3841 &clausesa[GFC_OMP_SPLIT_SIMD], omp_clauses);
f014c653
JJ		 3842 if (pblock == NULL)
3843 {
3844 if (TREE_CODE (body) != BIND_EXPR)
3845 body = build3_v (BIND_EXPR, NULL, body, poplevel (1, 0));
3846 else
3847 poplevel (0, 0);
3848 }
3849 else if (TREE_CODE (body) != BIND_EXPR)
3850 body = build3_v (BIND_EXPR, NULL, body, NULL_TREE);
c61819ff 3851 if (flag_openmp)
92d28cbb
JJ		 3852 {
3853 stmt = make_node (OMP_FOR);
3854 TREE_TYPE (stmt) = void_type_node;
3855 OMP_FOR_BODY (stmt) = body;
3856 OMP_FOR_CLAUSES (stmt) = omp_do_clauses;
3857 }
3858 else
3859 stmt = body;
dd2fc525
JJ		 3860 gfc_add_expr_to_block (&block, stmt);
3861 return gfc_finish_block (&block);
3862}
3863
3864static tree
f014c653
JJ		 3865gfc_trans_omp_parallel_do (gfc_code *code, stmtblock_t *pblock,
3866 gfc_omp_clauses *clausesa)
dd2fc525 3867{
f014c653
JJ		 3868 stmtblock_t block, *new_pblock = pblock;
3869 gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
dd2fc525
JJ		 3870 tree stmt, omp_clauses = NULL_TREE;
3871
f014c653
JJ		 3872 if (pblock == NULL)
3873 gfc_start_block (&block);
3874 else
3875 gfc_init_block (&block);
dd2fc525 3876
f014c653
JJ		 3877 if (clausesa == NULL)
3878 {
3879 clausesa = clausesa_buf;
3880 gfc_split_omp_clauses (code, clausesa);
3881 }
dd2fc525
JJ		 3882 omp_clauses
3883 = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_PARALLEL],
3884 code->loc);
f014c653
JJ		 3885 if (pblock == NULL)
3886 {
3887 if (!clausesa[GFC_OMP_SPLIT_DO].ordered
3888 && clausesa[GFC_OMP_SPLIT_DO].sched_kind != OMP_SCHED_STATIC)
3889 new_pblock = &block;
3890 else
3891 pushlevel ();
3892 }
3893 stmt = gfc_trans_omp_do (code, EXEC_OMP_DO, new_pblock,
dd2fc525 3894 &clausesa[GFC_OMP_SPLIT_DO], omp_clauses);
f014c653
JJ		 3895 if (pblock == NULL)
3896 {
3897 if (TREE_CODE (stmt) != BIND_EXPR)
3898 stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
3899 else
3900 poplevel (0, 0);
3901 }
3902 else if (TREE_CODE (stmt) != BIND_EXPR)
3903 stmt = build3_v (BIND_EXPR, NULL, stmt, NULL_TREE);
dd2fc525
JJ		 3904 stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
3905 omp_clauses);
3906 OMP_PARALLEL_COMBINED (stmt) = 1;
3907 gfc_add_expr_to_block (&block, stmt);
3908 return gfc_finish_block (&block);
3909}
3910
3911static tree
f014c653
JJ		 3912gfc_trans_omp_parallel_do_simd (gfc_code *code, stmtblock_t *pblock,
3913 gfc_omp_clauses *clausesa)
dd2fc525
JJ		 3914{
3915 stmtblock_t block;
f014c653 3916 gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
dd2fc525
JJ		 3917 tree stmt, omp_clauses = NULL_TREE;
3918
f014c653
JJ		 3919 if (pblock == NULL)
3920 gfc_start_block (&block);
3921 else
3922 gfc_init_block (&block);
dd2fc525 3923
f014c653
JJ		 3924 if (clausesa == NULL)
3925 {
3926 clausesa = clausesa_buf;
3927 gfc_split_omp_clauses (code, clausesa);
3928 }
c61819ff 3929 if (flag_openmp)
92d28cbb
JJ		 3930 omp_clauses
3931 = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_PARALLEL],
3932 code->loc);
f014c653
JJ		 3933 if (pblock == NULL)
3934 pushlevel ();
3935 stmt = gfc_trans_omp_do_simd (code, pblock, clausesa, omp_clauses);
3936 if (pblock == NULL)
3937 {
3938 if (TREE_CODE (stmt) != BIND_EXPR)
3939 stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
3940 else
3941 poplevel (0, 0);
3942 }
3943 else if (TREE_CODE (stmt) != BIND_EXPR)
3944 stmt = build3_v (BIND_EXPR, NULL, stmt, NULL_TREE);
c61819ff 3945 if (flag_openmp)
92d28cbb
JJ		 3946 {
3947 stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
3948 omp_clauses);
3949 OMP_PARALLEL_COMBINED (stmt) = 1;
3950 }
6c7a4dfd
JJ		 3951 gfc_add_expr_to_block (&block, stmt);
3952 return gfc_finish_block (&block);
3953}
3954
3955static tree
3956gfc_trans_omp_parallel_sections (gfc_code *code)
3957{
3958 stmtblock_t block;
3959 gfc_omp_clauses section_clauses;
3960 tree stmt, omp_clauses;
3961
3962 memset (&section_clauses, 0, sizeof (section_clauses));
3963 section_clauses.nowait = true;
3964
3965 gfc_start_block (&block);
3966 omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
3967 code->loc);
87a60f68 3968 pushlevel ();
6c7a4dfd
JJ		 3969 stmt = gfc_trans_omp_sections (code, &section_clauses);
3970 if (TREE_CODE (stmt) != BIND_EXPR)
87a60f68 3971 stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
6c7a4dfd 3972 else
87a60f68 3973 poplevel (0, 0);
5d44e5c8
TB		 3974 stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
3975 omp_clauses);
761041be 3976 OMP_PARALLEL_COMBINED (stmt) = 1;
6c7a4dfd
JJ		 3977 gfc_add_expr_to_block (&block, stmt);
3978 return gfc_finish_block (&block);
3979}
3980
3981static tree
3982gfc_trans_omp_parallel_workshare (gfc_code *code)
3983{
3984 stmtblock_t block;
3985 gfc_omp_clauses workshare_clauses;
3986 tree stmt, omp_clauses;
3987
3988 memset (&workshare_clauses, 0, sizeof (workshare_clauses));
3989 workshare_clauses.nowait = true;
3990
3991 gfc_start_block (&block);
3992 omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
3993 code->loc);
87a60f68 3994 pushlevel ();
6c7a4dfd
JJ		 3995 stmt = gfc_trans_omp_workshare (code, &workshare_clauses);
3996 if (TREE_CODE (stmt) != BIND_EXPR)
87a60f68 3997 stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
6c7a4dfd 3998 else
87a60f68 3999 poplevel (0, 0);
5d44e5c8
TB		 4000 stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
4001 omp_clauses);
761041be 4002 OMP_PARALLEL_COMBINED (stmt) = 1;
6c7a4dfd
JJ		 4003 gfc_add_expr_to_block (&block, stmt);
4004 return gfc_finish_block (&block);
4005}
4006
4007static tree
4008gfc_trans_omp_sections (gfc_code *code, gfc_omp_clauses *clauses)
4009{
4010 stmtblock_t block, body;
4011 tree omp_clauses, stmt;
4012 bool has_lastprivate = clauses->lists[OMP_LIST_LASTPRIVATE] != NULL;
4013
4014 gfc_start_block (&block);
4015
4016 omp_clauses = gfc_trans_omp_clauses (&block, clauses, code->loc);
4017
4018 gfc_init_block (&body);
4019 for (code = code->block; code; code = code->block)
4020 {
4021 /* Last section is special because of lastprivate, so even if it
4022 is empty, chain it in. */
4023 stmt = gfc_trans_omp_code (code->next,
4024 has_lastprivate && code->block == NULL);
4025 if (! IS_EMPTY_STMT (stmt))
4026 {
4027 stmt = build1_v (OMP_SECTION, stmt);
4028 gfc_add_expr_to_block (&body, stmt);
4029 }
4030 }
4031 stmt = gfc_finish_block (&body);
4032
5d44e5c8
TB		 4033 stmt = build2_loc (input_location, OMP_SECTIONS, void_type_node, stmt,
4034 omp_clauses);
6c7a4dfd
JJ		 4035 gfc_add_expr_to_block (&block, stmt);
4036
4037 return gfc_finish_block (&block);
4038}
4039
4040static tree
4041gfc_trans_omp_single (gfc_code *code, gfc_omp_clauses *clauses)
4042{
4043 tree omp_clauses = gfc_trans_omp_clauses (NULL, clauses, code->loc);
4044 tree stmt = gfc_trans_omp_code (code->block->next, true);
5d44e5c8
TB		 4045 stmt = build2_loc (input_location, OMP_SINGLE, void_type_node, stmt,
4046 omp_clauses);
6c7a4dfd
JJ		 4047 return stmt;
4048}
4049
a68ab351
JJ		 4050static tree
4051gfc_trans_omp_task (gfc_code *code)
4052{
4053 stmtblock_t block;
726a989a 4054 tree stmt, omp_clauses;
a68ab351
JJ		 4055
4056 gfc_start_block (&block);
4057 omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
4058 code->loc);
726a989a 4059 stmt = gfc_trans_omp_code (code->block->next, true);
5d44e5c8
TB		 4060 stmt = build2_loc (input_location, OMP_TASK, void_type_node, stmt,
4061 omp_clauses);
a68ab351
JJ		 4062 gfc_add_expr_to_block (&block, stmt);
4063 return gfc_finish_block (&block);
4064}
4065
dd2fc525
JJ		 4066static tree
4067gfc_trans_omp_taskgroup (gfc_code *code)
4068{
4069 tree stmt = gfc_trans_code (code->block->next);
4070 return build1_loc (input_location, OMP_TASKGROUP, void_type_node, stmt);
4071}
4072
a68ab351
JJ		 4073static tree
4074gfc_trans_omp_taskwait (void)
4075{
e79983f4 4076 tree decl = builtin_decl_explicit (BUILT_IN_GOMP_TASKWAIT);
db3927fb 4077 return build_call_expr_loc (input_location, decl, 0);
a68ab351
JJ		 4078}
4079
20906c66
JJ		 4080static tree
4081gfc_trans_omp_taskyield (void)
4082{
e79983f4 4083 tree decl = builtin_decl_explicit (BUILT_IN_GOMP_TASKYIELD);
20906c66
JJ		 4084 return build_call_expr_loc (input_location, decl, 0);
4085}
4086
f014c653
JJ		 4087static tree
4088gfc_trans_omp_distribute (gfc_code *code, gfc_omp_clauses *clausesa)
4089{
4090 stmtblock_t block;
4091 gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
4092 tree stmt, omp_clauses = NULL_TREE;
4093
4094 gfc_start_block (&block);
4095 if (clausesa == NULL)
4096 {
4097 clausesa = clausesa_buf;
4098 gfc_split_omp_clauses (code, clausesa);
4099 }
c61819ff 4100 if (flag_openmp)
f014c653
JJ		 4101 omp_clauses
4102 = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_DISTRIBUTE],
4103 code->loc);
4104 switch (code->op)
4105 {
4106 case EXEC_OMP_DISTRIBUTE:
4107 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
4108 case EXEC_OMP_TEAMS_DISTRIBUTE:
4109 /* This is handled in gfc_trans_omp_do. */
4110 gcc_unreachable ();
4111 break;
4112 case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
4113 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
4114 case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
4115 stmt = gfc_trans_omp_parallel_do (code, &block, clausesa);
4116 if (TREE_CODE (stmt) != BIND_EXPR)
4117 stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
4118 else
4119 poplevel (0, 0);
4120 break;
4121 case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
4122 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
4123 case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
4124 stmt = gfc_trans_omp_parallel_do_simd (code, &block, clausesa);
4125 if (TREE_CODE (stmt) != BIND_EXPR)
4126 stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
4127 else
4128 poplevel (0, 0);
4129 break;
4130 case EXEC_OMP_DISTRIBUTE_SIMD:
4131 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
4132 case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
4133 stmt = gfc_trans_omp_do (code, EXEC_OMP_SIMD, &block,
4134 &clausesa[GFC_OMP_SPLIT_SIMD], NULL_TREE);
4135 if (TREE_CODE (stmt) != BIND_EXPR)
4136 stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
4137 else
4138 poplevel (0, 0);
4139 break;
4140 default:
4141 gcc_unreachable ();
4142 }
c61819ff 4143 if (flag_openmp)
f014c653
JJ		 4144 {
4145 tree distribute = make_node (OMP_DISTRIBUTE);
4146 TREE_TYPE (distribute) = void_type_node;
4147 OMP_FOR_BODY (distribute) = stmt;
4148 OMP_FOR_CLAUSES (distribute) = omp_clauses;
4149 stmt = distribute;
4150 }
4151 gfc_add_expr_to_block (&block, stmt);
4152 return gfc_finish_block (&block);
4153}
4154
4155static tree
4156gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa)
4157{
4158 stmtblock_t block;
4159 gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
4160 tree stmt, omp_clauses = NULL_TREE;
41b37d5e 4161 bool combined = true;
f014c653
JJ		 4162
4163 gfc_start_block (&block);
4164 if (clausesa == NULL)
4165 {
4166 clausesa = clausesa_buf;
4167 gfc_split_omp_clauses (code, clausesa);
4168 }
c61819ff 4169 if (flag_openmp)
f014c653
JJ		 4170 omp_clauses
4171 = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TEAMS],
4172 code->loc);
4173 switch (code->op)
4174 {
4175 case EXEC_OMP_TARGET_TEAMS:
4176 case EXEC_OMP_TEAMS:
4177 stmt = gfc_trans_omp_code (code->block->next, true);
41b37d5e 4178 combined = false;
f014c653
JJ		 4179 break;
4180 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
4181 case EXEC_OMP_TEAMS_DISTRIBUTE:
4182 stmt = gfc_trans_omp_do (code, EXEC_OMP_DISTRIBUTE, NULL,
4183 &clausesa[GFC_OMP_SPLIT_DISTRIBUTE],
4184 NULL);
4185 break;
4186 default:
4187 stmt = gfc_trans_omp_distribute (code, clausesa);
4188 break;
4189 }
4190 stmt = build2_loc (input_location, OMP_TEAMS, void_type_node, stmt,
4191 omp_clauses);
41b37d5e
JJ		 4192 if (combined)
4193 OMP_TEAMS_COMBINED (stmt) = 1;
f014c653
JJ		 4194 gfc_add_expr_to_block (&block, stmt);
4195 return gfc_finish_block (&block);
4196}
4197
4198static tree
4199gfc_trans_omp_target (gfc_code *code)
4200{
4201 stmtblock_t block;
4202 gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM];
4203 tree stmt, omp_clauses = NULL_TREE;
4204
4205 gfc_start_block (&block);
4206 gfc_split_omp_clauses (code, clausesa);
c61819ff 4207 if (flag_openmp)
f014c653
JJ		 4208 omp_clauses
4209 = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TARGET],
4210 code->loc);
4211 if (code->op == EXEC_OMP_TARGET)
4212 stmt = gfc_trans_omp_code (code->block->next, true);
4213 else
41b37d5e
JJ		 4214 {
4215 pushlevel ();
4216 stmt = gfc_trans_omp_teams (code, clausesa);
4217 if (TREE_CODE (stmt) != BIND_EXPR)
4218 stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
4219 else
4220 poplevel (0, 0);
4221 }
c61819ff 4222 if (flag_openmp)
f014c653
JJ		 4223 stmt = build2_loc (input_location, OMP_TARGET, void_type_node, stmt,
4224 omp_clauses);
4225 gfc_add_expr_to_block (&block, stmt);
4226 return gfc_finish_block (&block);
4227}
4228
4229static tree
4230gfc_trans_omp_target_data (gfc_code *code)
4231{
4232 stmtblock_t block;
4233 tree stmt, omp_clauses;
4234
4235 gfc_start_block (&block);
4236 omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
4237 code->loc);
4238 stmt = gfc_trans_omp_code (code->block->next, true);
4239 stmt = build2_loc (input_location, OMP_TARGET_DATA, void_type_node, stmt,
4240 omp_clauses);
4241 gfc_add_expr_to_block (&block, stmt);
4242 return gfc_finish_block (&block);
4243}
4244
4245static tree
4246gfc_trans_omp_target_update (gfc_code *code)
4247{
4248 stmtblock_t block;
4249 tree stmt, omp_clauses;
4250
4251 gfc_start_block (&block);
4252 omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
4253 code->loc);
4254 stmt = build1_loc (input_location, OMP_TARGET_UPDATE, void_type_node,
4255 omp_clauses);
4256 gfc_add_expr_to_block (&block, stmt);
4257 return gfc_finish_block (&block);
4258}
4259
6c7a4dfd
JJ		 4260static tree
4261gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses)
4262{
34d01e1d
VL		 4263 tree res, tmp, stmt;
4264 stmtblock_t block, *pblock = NULL;
4265 stmtblock_t singleblock;
4266 int saved_ompws_flags;
4267 bool singleblock_in_progress = false;
4268 /* True if previous gfc_code in workshare construct is not workshared. */
4269 bool prev_singleunit;
4270
4271 code = code->block->next;
4272
87a60f68 4273 pushlevel ();
34d01e1d 4274
34d01e1d
VL		 4275 gfc_start_block (&block);
4276 pblock = &block;
4277
4278 ompws_flags = OMPWS_WORKSHARE_FLAG;
4279 prev_singleunit = false;
4280
4281 /* Translate statements one by one to trees until we reach
4282 the end of the workshare construct. Adjacent gfc_codes that
4283 are a single unit of work are clustered and encapsulated in a
4284 single OMP_SINGLE construct. */
4285 for (; code; code = code->next)
4286 {
4287 if (code->here != 0)
4288 {
4289 res = gfc_trans_label_here (code);
4290 gfc_add_expr_to_block (pblock, res);
4291 }
4292
4293 /* No dependence analysis, use for clauses with wait.
4294 If this is the last gfc_code, use default omp_clauses. */
4295 if (code->next == NULL && clauses->nowait)
4296 ompws_flags |= OMPWS_NOWAIT;
4297
4298 /* By default, every gfc_code is a single unit of work. */
4299 ompws_flags |= OMPWS_CURR_SINGLEUNIT;
4300 ompws_flags &= ~OMPWS_SCALARIZER_WS;
4301
4302 switch (code->op)
4303 {
4304 case EXEC_NOP:
4305 res = NULL_TREE;
4306 break;
4307
4308 case EXEC_ASSIGN:
4309 res = gfc_trans_assign (code);
4310 break;
4311
4312 case EXEC_POINTER_ASSIGN:
4313 res = gfc_trans_pointer_assign (code);
4314 break;
4315
4316 case EXEC_INIT_ASSIGN:
4317 res = gfc_trans_init_assign (code);
4318 break;
4319
4320 case EXEC_FORALL:
4321 res = gfc_trans_forall (code);
4322 break;
4323
4324 case EXEC_WHERE:
4325 res = gfc_trans_where (code);
4326 break;
4327
4328 case EXEC_OMP_ATOMIC:
4329 res = gfc_trans_omp_directive (code);
4330 break;
4331
4332 case EXEC_OMP_PARALLEL:
4333 case EXEC_OMP_PARALLEL_DO:
4334 case EXEC_OMP_PARALLEL_SECTIONS:
4335 case EXEC_OMP_PARALLEL_WORKSHARE:
4336 case EXEC_OMP_CRITICAL:
4337 saved_ompws_flags = ompws_flags;
4338 ompws_flags = 0;
4339 res = gfc_trans_omp_directive (code);
4340 ompws_flags = saved_ompws_flags;
4341 break;
4342
4343 default:
17d5d49f 4344 gfc_internal_error ("gfc_trans_omp_workshare(): Bad statement code");
34d01e1d
VL		 4345 }
4346
4347 gfc_set_backend_locus (&code->loc);
4348
4349 if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
4350 {
34d01e1d
VL		 4351 if (prev_singleunit)
4352 {
4353 if (ompws_flags & OMPWS_CURR_SINGLEUNIT)
4354 /* Add current gfc_code to single block. */
4355 gfc_add_expr_to_block (&singleblock, res);
4356 else
4357 {
4358 /* Finish single block and add it to pblock. */
4359 tmp = gfc_finish_block (&singleblock);
5d44e5c8
TB		 4360 tmp = build2_loc (input_location, OMP_SINGLE,
4361 void_type_node, tmp, NULL_TREE);
34d01e1d
VL		 4362 gfc_add_expr_to_block (pblock, tmp);
4363 /* Add current gfc_code to pblock. */
4364 gfc_add_expr_to_block (pblock, res);
4365 singleblock_in_progress = false;
4366 }
4367 }
4368 else
4369 {
4370 if (ompws_flags & OMPWS_CURR_SINGLEUNIT)
4371 {
4372 /* Start single block. */
4373 gfc_init_block (&singleblock);
4374 gfc_add_expr_to_block (&singleblock, res);
4375 singleblock_in_progress = true;
4376 }
4377 else
4378 /* Add the new statement to the block. */
4379 gfc_add_expr_to_block (pblock, res);
4380 }
4381 prev_singleunit = (ompws_flags & OMPWS_CURR_SINGLEUNIT) != 0;
4382 }
4383 }
4384
4385 /* Finish remaining SINGLE block, if we were in the middle of one. */
4386 if (singleblock_in_progress)
4387 {
4388 /* Finish single block and add it to pblock. */
4389 tmp = gfc_finish_block (&singleblock);
5d44e5c8
TB		 4390 tmp = build2_loc (input_location, OMP_SINGLE, void_type_node, tmp,
4391 clauses->nowait
4392 ? build_omp_clause (input_location, OMP_CLAUSE_NOWAIT)
4393 : NULL_TREE);
34d01e1d
VL		 4394 gfc_add_expr_to_block (pblock, tmp);
4395 }
4396
4397 stmt = gfc_finish_block (pblock);
4398 if (TREE_CODE (stmt) != BIND_EXPR)
4399 {
4400 if (!IS_EMPTY_STMT (stmt))
4401 {
87a60f68 4402 tree bindblock = poplevel (1, 0);
34d01e1d
VL		 4403 stmt = build3_v (BIND_EXPR, NULL, stmt, bindblock);
4404 }
4405 else
87a60f68 4406 poplevel (0, 0);
34d01e1d
VL		 4407 }
4408 else
87a60f68 4409 poplevel (0, 0);
34d01e1d 4410
c26dffff
JJ		 4411 if (IS_EMPTY_STMT (stmt) && !clauses->nowait)
4412 stmt = gfc_trans_omp_barrier ();
4413
34d01e1d
VL		 4414 ompws_flags = 0;
4415 return stmt;
6c7a4dfd
JJ		 4416}
4417
41dbbb37 4418tree
dc7a8b4b 4419gfc_trans_oacc_declare (gfc_code *code)
41dbbb37 4420{
dc7a8b4b
JN		 4421 stmtblock_t block;
4422 tree stmt, oacc_clauses;
4423 enum tree_code construct_code;
4424
4425 construct_code = OACC_DATA;
4426
4427 gfc_start_block (&block);
4428
4429 oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.oacc_declare->clauses,
4430 code->loc);
4431 stmt = gfc_trans_omp_code (code->block->next, true);
4432 stmt = build2_loc (input_location, construct_code, void_type_node, stmt,
4433 oacc_clauses);
4434 gfc_add_expr_to_block (&block, stmt);
4435
4436 return gfc_finish_block (&block);
41dbbb37
TS		 4437}
4438
4439tree
4440gfc_trans_oacc_directive (gfc_code *code)
4441{
4442 switch (code->op)
4443 {
4444 case EXEC_OACC_PARALLEL_LOOP:
4445 case EXEC_OACC_KERNELS_LOOP:
4446 return gfc_trans_oacc_combined_directive (code);
4447 case EXEC_OACC_PARALLEL:
4448 case EXEC_OACC_KERNELS:
4449 case EXEC_OACC_DATA:
4450 case EXEC_OACC_HOST_DATA:
4451 return gfc_trans_oacc_construct (code);
4452 case EXEC_OACC_LOOP:
4453 return gfc_trans_omp_do (code, code->op, NULL, code->ext.omp_clauses,
4454 NULL);
4455 case EXEC_OACC_UPDATE:
4456 case EXEC_OACC_CACHE:
4457 case EXEC_OACC_ENTER_DATA:
4458 case EXEC_OACC_EXIT_DATA:
4459 return gfc_trans_oacc_executable_directive (code);
4460 case EXEC_OACC_WAIT:
4461 return gfc_trans_oacc_wait_directive (code);
4bf9e5a8
TS		 4462 case EXEC_OACC_ATOMIC:
4463 return gfc_trans_omp_atomic (code);
dc7a8b4b
JN		 4464 case EXEC_OACC_DECLARE:
4465 return gfc_trans_oacc_declare (code);
41dbbb37
TS		 4466 default:
4467 gcc_unreachable ();
4468 }
4469}
4470
6c7a4dfd
JJ		 4471tree
4472gfc_trans_omp_directive (gfc_code *code)
4473{
4474 switch (code->op)
4475 {
4476 case EXEC_OMP_ATOMIC:
4477 return gfc_trans_omp_atomic (code);
4478 case EXEC_OMP_BARRIER:
4479 return gfc_trans_omp_barrier ();
dd2fc525
JJ		 4480 case EXEC_OMP_CANCEL:
4481 return gfc_trans_omp_cancel (code);
4482 case EXEC_OMP_CANCELLATION_POINT:
4483 return gfc_trans_omp_cancellation_point (code);
6c7a4dfd
JJ		 4484 case EXEC_OMP_CRITICAL:
4485 return gfc_trans_omp_critical (code);
f014c653 4486 case EXEC_OMP_DISTRIBUTE:
6c7a4dfd 4487 case EXEC_OMP_DO:
dd2fc525
JJ		 4488 case EXEC_OMP_SIMD:
4489 return gfc_trans_omp_do (code, code->op, NULL, code->ext.omp_clauses,
4490 NULL);
f014c653
JJ		 4491 case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
4492 case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
4493 case EXEC_OMP_DISTRIBUTE_SIMD:
4494 return gfc_trans_omp_distribute (code, NULL);
dd2fc525 4495 case EXEC_OMP_DO_SIMD:
f014c653 4496 return gfc_trans_omp_do_simd (code, NULL, NULL, NULL_TREE);
6c7a4dfd
JJ		 4497 case EXEC_OMP_FLUSH:
4498 return gfc_trans_omp_flush ();
4499 case EXEC_OMP_MASTER:
4500 return gfc_trans_omp_master (code);
4501 case EXEC_OMP_ORDERED:
4502 return gfc_trans_omp_ordered (code);
4503 case EXEC_OMP_PARALLEL:
4504 return gfc_trans_omp_parallel (code);
4505 case EXEC_OMP_PARALLEL_DO:
f014c653 4506 return gfc_trans_omp_parallel_do (code, NULL, NULL);
dd2fc525 4507 case EXEC_OMP_PARALLEL_DO_SIMD:
f014c653 4508 return gfc_trans_omp_parallel_do_simd (code, NULL, NULL);
6c7a4dfd
JJ		 4509 case EXEC_OMP_PARALLEL_SECTIONS:
4510 return gfc_trans_omp_parallel_sections (code);
4511 case EXEC_OMP_PARALLEL_WORKSHARE:
4512 return gfc_trans_omp_parallel_workshare (code);
4513 case EXEC_OMP_SECTIONS:
4514 return gfc_trans_omp_sections (code, code->ext.omp_clauses);
4515 case EXEC_OMP_SINGLE:
4516 return gfc_trans_omp_single (code, code->ext.omp_clauses);
f014c653
JJ		 4517 case EXEC_OMP_TARGET:
4518 case EXEC_OMP_TARGET_TEAMS:
4519 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
4520 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
4521 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
4522 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
4523 return gfc_trans_omp_target (code);
4524 case EXEC_OMP_TARGET_DATA:
4525 return gfc_trans_omp_target_data (code);
4526 case EXEC_OMP_TARGET_UPDATE:
4527 return gfc_trans_omp_target_update (code);
a68ab351
JJ		 4528 case EXEC_OMP_TASK:
4529 return gfc_trans_omp_task (code);
dd2fc525
JJ		 4530 case EXEC_OMP_TASKGROUP:
4531 return gfc_trans_omp_taskgroup (code);
a68ab351
JJ		 4532 case EXEC_OMP_TASKWAIT:
4533 return gfc_trans_omp_taskwait ();
20906c66
JJ		 4534 case EXEC_OMP_TASKYIELD:
4535 return gfc_trans_omp_taskyield ();
f014c653
JJ		 4536 case EXEC_OMP_TEAMS:
4537 case EXEC_OMP_TEAMS_DISTRIBUTE:
4538 case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
4539 case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
4540 case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
4541 return gfc_trans_omp_teams (code, NULL);
6c7a4dfd
JJ		 4542 case EXEC_OMP_WORKSHARE:
4543 return gfc_trans_omp_workshare (code, code->ext.omp_clauses);
4544 default:
4545 gcc_unreachable ();
4546 }
4547}
dd2fc525
JJ		 4548
4549void
4550gfc_trans_omp_declare_simd (gfc_namespace *ns)
4551{
4552 if (ns->entries)
4553 return;
4554
4555 gfc_omp_declare_simd *ods;
4556 for (ods = ns->omp_declare_simd; ods; ods = ods->next)
4557 {
4558 tree c = gfc_trans_omp_clauses (NULL, ods->clauses, ods->where, true);
4559 tree fndecl = ns->proc_name->backend_decl;
4560 if (c != NULL_TREE)
4561 c = tree_cons (NULL_TREE, c, NULL_TREE);
4562 c = build_tree_list (get_identifier ("omp declare simd"), c);
4563 TREE_CHAIN (c) = DECL_ATTRIBUTES (fndecl);
4564 DECL_ATTRIBUTES (fndecl) = c;
4565 }
4566}
Mirror of https://gcc.gnu.org/git/gcc.git