gcc/fortran/trans-openmp.c

   1 /* OpenMP directive translation -- generate GCC trees from gfc_code.
   2    Copyright (C) 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
   3    Contributed by Jakub Jelinek <jakub@redhat.com>
   4
   5 This file is part of GCC.
   6
   7 GCC is free software; you can redistribute it and/or modify it under
   8 the terms of the GNU General Public License as published by the Free
   9 Software Foundation; either version 3, or (at your option) any later
  10 version.
  11
  12 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
  13 WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15 for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with GCC; see the file COPYING3.  If not see
  19 <http://www.gnu.org/licenses/>.  */
  20
  21
  22 #include "config.h"
  23 #include "system.h"
  24 #include "coretypes.h"
  25 #include "tree.h"
  26 #include "gimple.h"
  27 #include "ggc.h"
  28 #include "toplev.h"
  29 #include "real.h"
  30 #include "gfortran.h"
  31 #include "trans.h"
  32 #include "trans-stmt.h"
  33 #include "trans-types.h"
  34 #include "trans-array.h"
  35 #include "trans-const.h"
  36 #include "arith.h"
  37
  38 int ompws_flags;
  39
  40 /* True if OpenMP should privatize what this DECL points to rather
  41    than the DECL itself.  */
  42
  43 bool
  44 gfc_omp_privatize_by_reference (const_tree decl)
  45 {
  46   tree type = TREE_TYPE (decl);
  47
  48   if (TREE_CODE (type) == REFERENCE_TYPE
  49       && (!DECL_ARTIFICIAL (decl) || TREE_CODE (decl) == PARM_DECL))
  50     return true;
  51
  52   if (TREE_CODE (type) == POINTER_TYPE)
  53     {
  54       /* Array POINTER/ALLOCATABLE have aggregate types, all user variables
  55          that have POINTER_TYPE type and don't have GFC_POINTER_TYPE_P
  56          set are supposed to be privatized by reference.  */
  57       if (GFC_POINTER_TYPE_P (type))
  58         return false;
  59
  60       if (!DECL_ARTIFICIAL (decl))
  61         return true;
  62
  63       /* Some arrays are expanded as DECL_ARTIFICIAL pointers
  64          by the frontend.  */
  65       if (DECL_LANG_SPECIFIC (decl)
  66           && GFC_DECL_SAVED_DESCRIPTOR (decl))
  67         return true;
  68     }
  69
  70   return false;
  71 }
  72
  73 /* True if OpenMP sharing attribute of DECL is predetermined.  */
  74
  75 enum omp_clause_default_kind
  76 gfc_omp_predetermined_sharing (tree decl)
  77 {
  78   if (DECL_ARTIFICIAL (decl) && ! GFC_DECL_RESULT (decl))
  79     return OMP_CLAUSE_DEFAULT_SHARED;
  80
  81   /* Cray pointees shouldn't be listed in any clauses and should be
  82      gimplified to dereference of the corresponding Cray pointer.
  83      Make them all private, so that they are emitted in the debug
  84      information.  */
  85   if (GFC_DECL_CRAY_POINTEE (decl))
  86     return OMP_CLAUSE_DEFAULT_PRIVATE;
  87
  88   /* Assumed-size arrays are predetermined to inherit sharing
  89      attributes of the associated actual argument, which is shared
  90      for all we care.  */
  91   if (TREE_CODE (decl) == PARM_DECL
  92       && GFC_ARRAY_TYPE_P (TREE_TYPE (decl))
  93       && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (decl)) == GFC_ARRAY_UNKNOWN
  94       && GFC_TYPE_ARRAY_UBOUND (TREE_TYPE (decl),
  95                                 GFC_TYPE_ARRAY_RANK (TREE_TYPE (decl)) - 1)
  96          == NULL)
  97     return OMP_CLAUSE_DEFAULT_SHARED;
  98
  99   /* COMMON and EQUIVALENCE decls are shared.  They
 100      are only referenced through DECL_VALUE_EXPR of the variables
 101      contained in them.  If those are privatized, they will not be
 102      gimplified to the COMMON or EQUIVALENCE decls.  */
 103   if (GFC_DECL_COMMON_OR_EQUIV (decl) && ! DECL_HAS_VALUE_EXPR_P (decl))
 104     return OMP_CLAUSE_DEFAULT_SHARED;
 105
 106   if (GFC_DECL_RESULT (decl) && ! DECL_HAS_VALUE_EXPR_P (decl))
 107     return OMP_CLAUSE_DEFAULT_SHARED;
 108
 109   return OMP_CLAUSE_DEFAULT_UNSPECIFIED;
 110 }
 111
 112
 113 /* Return true if DECL in private clause needs
 114    OMP_CLAUSE_PRIVATE_OUTER_REF on the private clause.  */
 115 bool
 116 gfc_omp_private_outer_ref (tree decl)
 117 {
 118   tree type = TREE_TYPE (decl);
 119
 120   if (GFC_DESCRIPTOR_TYPE_P (type)
 121       && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE)
 122     return true;
 123
 124   return false;
 125 }
 126
 127 /* Return code to initialize DECL with its default constructor, or
 128    NULL if there's nothing to do.  */
 129
 130 tree
 131 gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer)
 132 {
 133   tree type = TREE_TYPE (decl), rank, size, esize, ptr, cond, then_b, else_b;
 134   stmtblock_t block, cond_block;
 135
 136   if (! GFC_DESCRIPTOR_TYPE_P (type)
 137       || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
 138     return NULL;
 139
 140   gcc_assert (outer != NULL);
 141   gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_PRIVATE
 142               || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LASTPRIVATE);
 143
 144   /* Allocatable arrays in PRIVATE clauses need to be set to
 145      "not currently allocated" allocation status if outer
 146      array is "not currently allocated", otherwise should be allocated.  */
 147   gfc_start_block (&block);
 148
 149   gfc_init_block (&cond_block);
 150
 151   gfc_add_modify (&cond_block, decl, outer);
 152   rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
 153   size = gfc_conv_descriptor_ubound (decl, rank);
 154   size = fold_build2 (MINUS_EXPR, gfc_array_index_type, size,
 155                       gfc_conv_descriptor_lbound (decl, rank));
 156   size = fold_build2 (PLUS_EXPR, gfc_array_index_type, size,
 157                       gfc_index_one_node);
 158   if (GFC_TYPE_ARRAY_RANK (type) > 1)
 159     size = fold_build2 (MULT_EXPR, gfc_array_index_type, size,
 160                         gfc_conv_descriptor_stride (decl, rank));
 161   esize = fold_convert (gfc_array_index_type,
 162                         TYPE_SIZE_UNIT (gfc_get_element_type (type)));
 163   size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, esize);
 164   size = gfc_evaluate_now (fold_convert (size_type_node, size), &cond_block);
 165   ptr = gfc_allocate_array_with_status (&cond_block,
 166                                         build_int_cst (pvoid_type_node, 0),
 167                                         size, NULL, NULL);
 168   gfc_conv_descriptor_data_set (&cond_block, decl, ptr);
 169   then_b = gfc_finish_block (&cond_block);
 170
 171   gfc_init_block (&cond_block);
 172   gfc_conv_descriptor_data_set (&cond_block, decl, null_pointer_node);
 173   else_b = gfc_finish_block (&cond_block);
 174
 175   cond = fold_build2 (NE_EXPR, boolean_type_node,
 176                       fold_convert (pvoid_type_node,
 177                                     gfc_conv_descriptor_data_get (outer)),
 178                       null_pointer_node);
 179   gfc_add_expr_to_block (&block, build3 (COND_EXPR, void_type_node,
 180                          cond, then_b, else_b));
 181
 182   return gfc_finish_block (&block);
 183 }
 184
 185 /* Build and return code for a copy constructor from SRC to DEST.  */
 186
 187 tree
 188 gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
 189 {
 190   tree type = TREE_TYPE (dest), ptr, size, esize, rank, call;
 191   stmtblock_t block;
 192
 193   if (! GFC_DESCRIPTOR_TYPE_P (type)
 194       || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
 195     return build2_v (MODIFY_EXPR, dest, src);
 196
 197   gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_FIRSTPRIVATE);
 198
 199   /* Allocatable arrays in FIRSTPRIVATE clauses need to be allocated
 200      and copied from SRC.  */
 201   gfc_start_block (&block);
 202
 203   gfc_add_modify (&block, dest, src);
 204   rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
 205   size = gfc_conv_descriptor_ubound (dest, rank);
 206   size = fold_build2 (MINUS_EXPR, gfc_array_index_type, size,
 207                       gfc_conv_descriptor_lbound (dest, rank));
 208   size = fold_build2 (PLUS_EXPR, gfc_array_index_type, size,
 209                       gfc_index_one_node);
 210   if (GFC_TYPE_ARRAY_RANK (type) > 1)
 211     size = fold_build2 (MULT_EXPR, gfc_array_index_type, size,
 212                         gfc_conv_descriptor_stride (dest, rank));
 213   esize = fold_convert (gfc_array_index_type,
 214                         TYPE_SIZE_UNIT (gfc_get_element_type (type)));
 215   size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, esize);
 216   size = gfc_evaluate_now (fold_convert (size_type_node, size), &block);
 217   ptr = gfc_allocate_array_with_status (&block,
 218                                         build_int_cst (pvoid_type_node, 0),
 219                                         size, NULL, NULL);
 220   gfc_conv_descriptor_data_set (&block, dest, ptr);
 221   call = build_call_expr (built_in_decls[BUILT_IN_MEMCPY], 3, ptr,
 222                           fold_convert (pvoid_type_node,
 223                                         gfc_conv_descriptor_data_get (src)),
 224                           size);
 225   gfc_add_expr_to_block (&block, fold_convert (void_type_node, call));
 226
 227   return gfc_finish_block (&block);
 228 }
 229
 230 /* Similarly, except use an assignment operator instead.  */
 231
 232 tree
 233 gfc_omp_clause_assign_op (tree clause ATTRIBUTE_UNUSED, tree dest, tree src)
 234 {
 235   tree type = TREE_TYPE (dest), rank, size, esize, call;
 236   stmtblock_t block;
 237
 238   if (! GFC_DESCRIPTOR_TYPE_P (type)
 239       || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
 240     return build2_v (MODIFY_EXPR, dest, src);
 241
 242   /* Handle copying allocatable arrays.  */
 243   gfc_start_block (&block);
 244
 245   rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
 246   size = gfc_conv_descriptor_ubound (dest, rank);
 247   size = fold_build2 (MINUS_EXPR, gfc_array_index_type, size,
 248                       gfc_conv_descriptor_lbound (dest, rank));
 249   size = fold_build2 (PLUS_EXPR, gfc_array_index_type, size,
 250                       gfc_index_one_node);
 251   if (GFC_TYPE_ARRAY_RANK (type) > 1)
 252     size = fold_build2 (MULT_EXPR, gfc_array_index_type, size,
 253                         gfc_conv_descriptor_stride (dest, rank));
 254   esize = fold_convert (gfc_array_index_type,
 255                         TYPE_SIZE_UNIT (gfc_get_element_type (type)));
 256   size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, esize);
 257   size = gfc_evaluate_now (fold_convert (size_type_node, size), &block);
 258   call = build_call_expr (built_in_decls[BUILT_IN_MEMCPY], 3,
 259                           fold_convert (pvoid_type_node,
 260                                         gfc_conv_descriptor_data_get (dest)),
 261                           fold_convert (pvoid_type_node,
 262                                         gfc_conv_descriptor_data_get (src)),
 263                           size);
 264   gfc_add_expr_to_block (&block, fold_convert (void_type_node, call));
 265
 266   return gfc_finish_block (&block);
 267 }
 268
 269 /* Build and return code destructing DECL.  Return NULL if nothing
 270    to be done.  */
 271
 272 tree
 273 gfc_omp_clause_dtor (tree clause ATTRIBUTE_UNUSED, tree decl)
 274 {
 275   tree type = TREE_TYPE (decl);
 276
 277   if (! GFC_DESCRIPTOR_TYPE_P (type)
 278       || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
 279     return NULL;
 280
 281   /* Allocatable arrays in FIRSTPRIVATE/LASTPRIVATE etc. clauses need
 282      to be deallocated if they were allocated.  */
 283   return gfc_trans_dealloc_allocated (decl);
 284 }
 285
 286
 287 /* Return true if DECL's DECL_VALUE_EXPR (if any) should be
 288    disregarded in OpenMP construct, because it is going to be
 289    remapped during OpenMP lowering.  SHARED is true if DECL
 290    is going to be shared, false if it is going to be privatized.  */
 291
 292 bool
 293 gfc_omp_disregard_value_expr (tree decl, bool shared)
 294 {
 295   if (GFC_DECL_COMMON_OR_EQUIV (decl)
 296       && DECL_HAS_VALUE_EXPR_P (decl))
 297     {
 298       tree value = DECL_VALUE_EXPR (decl);
 299
 300       if (TREE_CODE (value) == COMPONENT_REF
 301           && TREE_CODE (TREE_OPERAND (value, 0)) == VAR_DECL
 302           && GFC_DECL_COMMON_OR_EQUIV (TREE_OPERAND (value, 0)))
 303         {
 304           /* If variable in COMMON or EQUIVALENCE is privatized, return
 305              true, as just that variable is supposed to be privatized,
 306              not the whole COMMON or whole EQUIVALENCE.
 307              For shared variables in COMMON or EQUIVALENCE, let them be
 308              gimplified to DECL_VALUE_EXPR, so that for multiple shared vars
 309              from the same COMMON or EQUIVALENCE just one sharing of the
 310              whole COMMON or EQUIVALENCE is enough.  */
 311           return ! shared;
 312         }
 313     }
 314
 315   if (GFC_DECL_RESULT (decl) && DECL_HAS_VALUE_EXPR_P (decl))
 316     return ! shared;
 317
 318   return false;
 319 }
 320
 321 /* Return true if DECL that is shared iff SHARED is true should
 322    be put into OMP_CLAUSE_PRIVATE with OMP_CLAUSE_PRIVATE_DEBUG
 323    flag set.  */
 324
 325 bool
 326 gfc_omp_private_debug_clause (tree decl, bool shared)
 327 {
 328   if (GFC_DECL_CRAY_POINTEE (decl))
 329     return true;
 330
 331   if (GFC_DECL_COMMON_OR_EQUIV (decl)
 332       && DECL_HAS_VALUE_EXPR_P (decl))
 333     {
 334       tree value = DECL_VALUE_EXPR (decl);
 335
 336       if (TREE_CODE (value) == COMPONENT_REF
 337           && TREE_CODE (TREE_OPERAND (value, 0)) == VAR_DECL
 338           && GFC_DECL_COMMON_OR_EQUIV (TREE_OPERAND (value, 0)))
 339         return shared;
 340     }
 341
 342   return false;
 343 }
 344
 345 /* Register language specific type size variables as potentially OpenMP
 346    firstprivate variables.  */
 347
 348 void
 349 gfc_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *ctx, tree type)
 350 {
 351   if (GFC_ARRAY_TYPE_P (type) || GFC_DESCRIPTOR_TYPE_P (type))
 352     {
 353       int r;
 354
 355       gcc_assert (TYPE_LANG_SPECIFIC (type) != NULL);
 356       for (r = 0; r < GFC_TYPE_ARRAY_RANK (type); r++)
 357         {
 358           omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_LBOUND (type, r));
 359           omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_UBOUND (type, r));
 360           omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_STRIDE (type, r));
 361         }
 362       omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_SIZE (type));
 363       omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_OFFSET (type));
 364     }
 365 }
 366
 367
 368 static inline tree
 369 gfc_trans_add_clause (tree node, tree tail)
 370 {
 371   OMP_CLAUSE_CHAIN (node) = tail;
 372   return node;
 373 }
 374
 375 static tree
 376 gfc_trans_omp_variable (gfc_symbol *sym)
 377 {
 378   tree t = gfc_get_symbol_decl (sym);
 379   tree parent_decl;
 380   int parent_flag;
 381   bool return_value;
 382   bool alternate_entry;
 383   bool entry_master;
 384
 385   return_value = sym->attr.function && sym->result == sym;
 386   alternate_entry = sym->attr.function && sym->attr.entry
 387                     && sym->result == sym;
 388   entry_master = sym->attr.result
 389                  && sym->ns->proc_name->attr.entry_master
 390                  && !gfc_return_by_reference (sym->ns->proc_name);
 391   parent_decl = DECL_CONTEXT (current_function_decl);
 392
 393   if ((t == parent_decl && return_value)
 394        || (sym->ns && sym->ns->proc_name
 395            && sym->ns->proc_name->backend_decl == parent_decl
 396            && (alternate_entry || entry_master)))
 397     parent_flag = 1;
 398   else
 399     parent_flag = 0;
 400
 401   /* Special case for assigning the return value of a function.
 402      Self recursive functions must have an explicit return value.  */
 403   if (return_value && (t == current_function_decl || parent_flag))
 404     t = gfc_get_fake_result_decl (sym, parent_flag);
 405
 406   /* Similarly for alternate entry points.  */
 407   else if (alternate_entry
 408            && (sym->ns->proc_name->backend_decl == current_function_decl
 409                || parent_flag))
 410     {
 411       gfc_entry_list *el = NULL;
 412
 413       for (el = sym->ns->entries; el; el = el->next)
 414         if (sym == el->sym)
 415           {
 416             t = gfc_get_fake_result_decl (sym, parent_flag);
 417             break;
 418           }
 419     }
 420
 421   else if (entry_master
 422            && (sym->ns->proc_name->backend_decl == current_function_decl
 423                || parent_flag))
 424     t = gfc_get_fake_result_decl (sym, parent_flag);
 425
 426   return t;
 427 }
 428
 429 static tree
 430 gfc_trans_omp_variable_list (enum omp_clause_code code, gfc_namelist *namelist,
 431                              tree list)
 432 {
 433   for (; namelist != NULL; namelist = namelist->next)
 434     if (namelist->sym->attr.referenced)
 435       {
 436         tree t = gfc_trans_omp_variable (namelist->sym);
 437         if (t != error_mark_node)
 438           {
 439             tree node = build_omp_clause (code);
 440             OMP_CLAUSE_DECL (node) = t;
 441             list = gfc_trans_add_clause (node, list);
 442           }
 443       }
 444   return list;
 445 }
 446
 447 static void
 448 gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
 449 {
 450   gfc_symtree *root1 = NULL, *root2 = NULL, *root3 = NULL, *root4 = NULL;
 451   gfc_symtree *symtree1, *symtree2, *symtree3, *symtree4 = NULL;
 452   gfc_symbol init_val_sym, outer_sym, intrinsic_sym;
 453   gfc_expr *e1, *e2, *e3, *e4;
 454   gfc_ref *ref;
 455   tree decl, backend_decl, stmt;
 456   locus old_loc = gfc_current_locus;
 457   const char *iname;
 458   gfc_try t;
 459
 460   decl = OMP_CLAUSE_DECL (c);
 461   gfc_current_locus = where;
 462
 463   /* Create a fake symbol for init value.  */
 464   memset (&init_val_sym, 0, sizeof (init_val_sym));
 465   init_val_sym.ns = sym->ns;
 466   init_val_sym.name = sym->name;
 467   init_val_sym.ts = sym->ts;
 468   init_val_sym.attr.referenced = 1;
 469   init_val_sym.declared_at = where;
 470   init_val_sym.attr.flavor = FL_VARIABLE;
 471   backend_decl = omp_reduction_init (c, gfc_sym_type (&init_val_sym));
 472   init_val_sym.backend_decl = backend_decl;
 473
 474   /* Create a fake symbol for the outer array reference.  */
 475   outer_sym = *sym;
 476   outer_sym.as = gfc_copy_array_spec (sym->as);
 477   outer_sym.attr.dummy = 0;
 478   outer_sym.attr.result = 0;
 479   outer_sym.attr.flavor = FL_VARIABLE;
 480   outer_sym.backend_decl = create_tmp_var_raw (TREE_TYPE (decl), NULL);
 481
 482   /* Create fake symtrees for it.  */
 483   symtree1 = gfc_new_symtree (&root1, sym->name);
 484   symtree1->n.sym = sym;
 485   gcc_assert (symtree1 == root1);
 486
 487   symtree2 = gfc_new_symtree (&root2, sym->name);
 488   symtree2->n.sym = &init_val_sym;
 489   gcc_assert (symtree2 == root2);
 490
 491   symtree3 = gfc_new_symtree (&root3, sym->name);
 492   symtree3->n.sym = &outer_sym;
 493   gcc_assert (symtree3 == root3);
 494
 495   /* Create expressions.  */
 496   e1 = gfc_get_expr ();
 497   e1->expr_type = EXPR_VARIABLE;
 498   e1->where = where;
 499   e1->symtree = symtree1;
 500   e1->ts = sym->ts;
 501   e1->ref = ref = gfc_get_ref ();
 502   ref->type = REF_ARRAY;
 503   ref->u.ar.where = where;
 504   ref->u.ar.as = sym->as;
 505   ref->u.ar.type = AR_FULL;
 506   ref->u.ar.dimen = 0;
 507   t = gfc_resolve_expr (e1);
 508   gcc_assert (t == SUCCESS);
 509
 510   e2 = gfc_get_expr ();
 511   e2->expr_type = EXPR_VARIABLE;
 512   e2->where = where;
 513   e2->symtree = symtree2;
 514   e2->ts = sym->ts;
 515   t = gfc_resolve_expr (e2);
 516   gcc_assert (t == SUCCESS);
 517
 518   e3 = gfc_copy_expr (e1);
 519   e3->symtree = symtree3;
 520   t = gfc_resolve_expr (e3);
 521   gcc_assert (t == SUCCESS);
 522
 523   iname = NULL;
 524   switch (OMP_CLAUSE_REDUCTION_CODE (c))
 525     {
 526     case PLUS_EXPR:
 527     case MINUS_EXPR:
 528       e4 = gfc_add (e3, e1);
 529       break;
 530     case MULT_EXPR:
 531       e4 = gfc_multiply (e3, e1);
 532       break;
 533     case TRUTH_ANDIF_EXPR:
 534       e4 = gfc_and (e3, e1);
 535       break;
 536     case TRUTH_ORIF_EXPR:
 537       e4 = gfc_or (e3, e1);
 538       break;
 539     case EQ_EXPR:
 540       e4 = gfc_eqv (e3, e1);
 541       break;
 542     case NE_EXPR:
 543       e4 = gfc_neqv (e3, e1);
 544       break;
 545     case MIN_EXPR:
 546       iname = "min";
 547       break;
 548     case MAX_EXPR:
 549       iname = "max";
 550       break;
 551     case BIT_AND_EXPR:
 552       iname = "iand";
 553       break;
 554     case BIT_IOR_EXPR:
 555       iname = "ior";
 556       break;
 557     case BIT_XOR_EXPR:
 558       iname = "ieor";
 559       break;
 560     default:
 561       gcc_unreachable ();
 562     }
 563   if (iname != NULL)
 564     {
 565       memset (&intrinsic_sym, 0, sizeof (intrinsic_sym));
 566       intrinsic_sym.ns = sym->ns;
 567       intrinsic_sym.name = iname;
 568       intrinsic_sym.ts = sym->ts;
 569       intrinsic_sym.attr.referenced = 1;
 570       intrinsic_sym.attr.intrinsic = 1;
 571       intrinsic_sym.attr.function = 1;
 572       intrinsic_sym.result = &intrinsic_sym;
 573       intrinsic_sym.declared_at = where;
 574
 575       symtree4 = gfc_new_symtree (&root4, iname);
 576       symtree4->n.sym = &intrinsic_sym;
 577       gcc_assert (symtree4 == root4);
 578
 579       e4 = gfc_get_expr ();
 580       e4->expr_type = EXPR_FUNCTION;
 581       e4->where = where;
 582       e4->symtree = symtree4;
 583       e4->value.function.isym = gfc_find_function (iname);
 584       e4->value.function.actual = gfc_get_actual_arglist ();
 585       e4->value.function.actual->expr = e3;
 586       e4->value.function.actual->next = gfc_get_actual_arglist ();
 587       e4->value.function.actual->next->expr = e1;
 588     }
 589   /* e1 and e3 have been stored as arguments of e4, avoid sharing.  */
 590   e1 = gfc_copy_expr (e1);
 591   e3 = gfc_copy_expr (e3);
 592   t = gfc_resolve_expr (e4);
 593   gcc_assert (t == SUCCESS);
 594
 595   /* Create the init statement list.  */
 596   pushlevel (0);
 597   if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))
 598       && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (decl)) == GFC_ARRAY_ALLOCATABLE)
 599     {
 600       /* If decl is an allocatable array, it needs to be allocated
 601          with the same bounds as the outer var.  */
 602       tree type = TREE_TYPE (decl), rank, size, esize, ptr;
 603       stmtblock_t block;
 604
 605       gfc_start_block (&block);
 606
 607       gfc_add_modify (&block, decl, outer_sym.backend_decl);
 608       rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
 609       size = gfc_conv_descriptor_ubound (decl, rank);
 610       size = fold_build2 (MINUS_EXPR, gfc_array_index_type, size,
 611                           gfc_conv_descriptor_lbound (decl, rank));
 612       size = fold_build2 (PLUS_EXPR, gfc_array_index_type, size,
 613                           gfc_index_one_node);
 614       if (GFC_TYPE_ARRAY_RANK (type) > 1)
 615         size = fold_build2 (MULT_EXPR, gfc_array_index_type, size,
 616                             gfc_conv_descriptor_stride (decl, rank));
 617       esize = fold_convert (gfc_array_index_type,
 618                             TYPE_SIZE_UNIT (gfc_get_element_type (type)));
 619       size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, esize);
 620       size = gfc_evaluate_now (fold_convert (size_type_node, size), &block);
 621       ptr = gfc_allocate_array_with_status (&block,
 622                                             build_int_cst (pvoid_type_node, 0),
 623                                             size, NULL, NULL);
 624       gfc_conv_descriptor_data_set (&block, decl, ptr);
 625       gfc_add_expr_to_block (&block, gfc_trans_assignment (e1, e2, false));
 626       stmt = gfc_finish_block (&block);
 627     }
 628   else
 629     stmt = gfc_trans_assignment (e1, e2, false);
 630   if (TREE_CODE (stmt) != BIND_EXPR)
 631     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
 632   else
 633     poplevel (0, 0, 0);
 634   OMP_CLAUSE_REDUCTION_INIT (c) = stmt;
 635
 636   /* Create the merge statement list.  */
 637   pushlevel (0);
 638   if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))
 639       && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (decl)) == GFC_ARRAY_ALLOCATABLE)
 640     {
 641       /* If decl is an allocatable array, it needs to be deallocated
 642          afterwards.  */
 643       stmtblock_t block;
 644
 645       gfc_start_block (&block);
 646       gfc_add_expr_to_block (&block, gfc_trans_assignment (e3, e4, false));
 647       gfc_add_expr_to_block (&block, gfc_trans_dealloc_allocated (decl));
 648       stmt = gfc_finish_block (&block);
 649     }
 650   else
 651     stmt = gfc_trans_assignment (e3, e4, false);
 652   if (TREE_CODE (stmt) != BIND_EXPR)
 653     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
 654   else
 655     poplevel (0, 0, 0);
 656   OMP_CLAUSE_REDUCTION_MERGE (c) = stmt;
 657
 658   /* And stick the placeholder VAR_DECL into the clause as well.  */
 659   OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) = outer_sym.backend_decl;
 660
 661   gfc_current_locus = old_loc;
 662
 663   gfc_free_expr (e1);
 664   gfc_free_expr (e2);
 665   gfc_free_expr (e3);
 666   gfc_free_expr (e4);
 667   gfc_free (symtree1);
 668   gfc_free (symtree2);
 669   gfc_free (symtree3);
 670   if (symtree4)
 671     gfc_free (symtree4);
 672   gfc_free_array_spec (outer_sym.as);
 673 }
 674
 675 static tree
 676 gfc_trans_omp_reduction_list (gfc_namelist *namelist, tree list,
 677                               enum tree_code reduction_code, locus where)
 678 {
 679   for (; namelist != NULL; namelist = namelist->next)
 680     if (namelist->sym->attr.referenced)
 681       {
 682         tree t = gfc_trans_omp_variable (namelist->sym);
 683         if (t != error_mark_node)
 684           {
 685             tree node = build_omp_clause (OMP_CLAUSE_REDUCTION);
 686             OMP_CLAUSE_DECL (node) = t;
 687             OMP_CLAUSE_REDUCTION_CODE (node) = reduction_code;
 688             if (namelist->sym->attr.dimension)
 689               gfc_trans_omp_array_reduction (node, namelist->sym, where);
 690             list = gfc_trans_add_clause (node, list);
 691           }
 692       }
 693   return list;
 694 }
 695
 696 static tree
 697 gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 698                        locus where)
 699 {
 700   tree omp_clauses = NULL_TREE, chunk_size, c, old_clauses;
 701   int list;
 702   enum omp_clause_code clause_code;
 703   gfc_se se;
 704
 705   if (clauses == NULL)
 706     return NULL_TREE;
 707
 708   for (list = 0; list < OMP_LIST_NUM; list++)
 709     {
 710       gfc_namelist *n = clauses->lists[list];
 711
 712       if (n == NULL)
 713         continue;
 714       if (list >= OMP_LIST_REDUCTION_FIRST
 715           && list <= OMP_LIST_REDUCTION_LAST)
 716         {
 717           enum tree_code reduction_code;
 718           switch (list)
 719             {
 720             case OMP_LIST_PLUS:
 721               reduction_code = PLUS_EXPR;
 722               break;
 723             case OMP_LIST_MULT:
 724               reduction_code = MULT_EXPR;
 725               break;
 726             case OMP_LIST_SUB:
 727               reduction_code = MINUS_EXPR;
 728               break;
 729             case OMP_LIST_AND:
 730               reduction_code = TRUTH_ANDIF_EXPR;
 731               break;
 732             case OMP_LIST_OR:
 733               reduction_code = TRUTH_ORIF_EXPR;
 734               break;
 735             case OMP_LIST_EQV:
 736               reduction_code = EQ_EXPR;
 737               break;
 738             case OMP_LIST_NEQV:
 739               reduction_code = NE_EXPR;
 740               break;
 741             case OMP_LIST_MAX:
 742               reduction_code = MAX_EXPR;
 743               break;
 744             case OMP_LIST_MIN:
 745               reduction_code = MIN_EXPR;
 746               break;
 747             case OMP_LIST_IAND:
 748               reduction_code = BIT_AND_EXPR;
 749               break;
 750             case OMP_LIST_IOR:
 751               reduction_code = BIT_IOR_EXPR;
 752               break;
 753             case OMP_LIST_IEOR:
 754               reduction_code = BIT_XOR_EXPR;
 755               break;
 756             default:
 757               gcc_unreachable ();
 758             }
 759           old_clauses = omp_clauses;
 760           omp_clauses
 761             = gfc_trans_omp_reduction_list (n, omp_clauses, reduction_code,
 762                                             where);
 763           continue;
 764         }
 765       switch (list)
 766         {
 767         case OMP_LIST_PRIVATE:
 768           clause_code = OMP_CLAUSE_PRIVATE;
 769           goto add_clause;
 770         case OMP_LIST_SHARED:
 771           clause_code = OMP_CLAUSE_SHARED;
 772           goto add_clause;
 773         case OMP_LIST_FIRSTPRIVATE:
 774           clause_code = OMP_CLAUSE_FIRSTPRIVATE;
 775           goto add_clause;
 776         case OMP_LIST_LASTPRIVATE:
 777           clause_code = OMP_CLAUSE_LASTPRIVATE;
 778           goto add_clause;
 779         case OMP_LIST_COPYIN:
 780           clause_code = OMP_CLAUSE_COPYIN;
 781           goto add_clause;
 782         case OMP_LIST_COPYPRIVATE:
 783           clause_code = OMP_CLAUSE_COPYPRIVATE;
 784           /* FALLTHROUGH */
 785         add_clause:
 786           omp_clauses
 787             = gfc_trans_omp_variable_list (clause_code, n, omp_clauses);
 788           break;
 789         default:
 790           break;
 791         }
 792     }
 793
 794   if (clauses->if_expr)
 795     {
 796       tree if_var;
 797
 798       gfc_init_se (&se, NULL);
 799       gfc_conv_expr (&se, clauses->if_expr);
 800       gfc_add_block_to_block (block, &se.pre);
 801       if_var = gfc_evaluate_now (se.expr, block);
 802       gfc_add_block_to_block (block, &se.post);
 803
 804       c = build_omp_clause (OMP_CLAUSE_IF);
 805       OMP_CLAUSE_IF_EXPR (c) = if_var;
 806       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 807     }
 808
 809   if (clauses->num_threads)
 810     {
 811       tree num_threads;
 812
 813       gfc_init_se (&se, NULL);
 814       gfc_conv_expr (&se, clauses->num_threads);
 815       gfc_add_block_to_block (block, &se.pre);
 816       num_threads = gfc_evaluate_now (se.expr, block);
 817       gfc_add_block_to_block (block, &se.post);
 818
 819       c = build_omp_clause (OMP_CLAUSE_NUM_THREADS);
 820       OMP_CLAUSE_NUM_THREADS_EXPR (c) = num_threads;
 821       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 822     }
 823
 824   chunk_size = NULL_TREE;
 825   if (clauses->chunk_size)
 826     {
 827       gfc_init_se (&se, NULL);
 828       gfc_conv_expr (&se, clauses->chunk_size);
 829       gfc_add_block_to_block (block, &se.pre);
 830       chunk_size = gfc_evaluate_now (se.expr, block);
 831       gfc_add_block_to_block (block, &se.post);
 832     }
 833
 834   if (clauses->sched_kind != OMP_SCHED_NONE)
 835     {
 836       c = build_omp_clause (OMP_CLAUSE_SCHEDULE);
 837       OMP_CLAUSE_SCHEDULE_CHUNK_EXPR (c) = chunk_size;
 838       switch (clauses->sched_kind)
 839         {
 840         case OMP_SCHED_STATIC:
 841           OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_STATIC;
 842           break;
 843         case OMP_SCHED_DYNAMIC:
 844           OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_DYNAMIC;
 845           break;
 846         case OMP_SCHED_GUIDED:
 847           OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_GUIDED;
 848           break;
 849         case OMP_SCHED_RUNTIME:
 850           OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_RUNTIME;
 851           break;
 852         case OMP_SCHED_AUTO:
 853           OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_AUTO;
 854           break;
 855         default:
 856           gcc_unreachable ();
 857         }
 858       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 859     }
 860
 861   if (clauses->default_sharing != OMP_DEFAULT_UNKNOWN)
 862     {
 863       c = build_omp_clause (OMP_CLAUSE_DEFAULT);
 864       switch (clauses->default_sharing)
 865         {
 866         case OMP_DEFAULT_NONE:
 867           OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_NONE;
 868           break;
 869         case OMP_DEFAULT_SHARED:
 870           OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_SHARED;
 871           break;
 872         case OMP_DEFAULT_PRIVATE:
 873           OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_PRIVATE;
 874           break;
 875         case OMP_DEFAULT_FIRSTPRIVATE:
 876           OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_FIRSTPRIVATE;
 877           break;
 878         default:
 879           gcc_unreachable ();
 880         }
 881       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 882     }
 883
 884   if (clauses->nowait)
 885     {
 886       c = build_omp_clause (OMP_CLAUSE_NOWAIT);
 887       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 888     }
 889
 890   if (clauses->ordered)
 891     {
 892       c = build_omp_clause (OMP_CLAUSE_ORDERED);
 893       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 894     }
 895
 896   if (clauses->untied)
 897     {
 898       c = build_omp_clause (OMP_CLAUSE_UNTIED);
 899       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 900     }
 901
 902   if (clauses->collapse)
 903     {
 904       c = build_omp_clause (OMP_CLAUSE_COLLAPSE);
 905       OMP_CLAUSE_COLLAPSE_EXPR (c) = build_int_cst (NULL, clauses->collapse);
 906       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 907     }
 908
 909   return omp_clauses;
 910 }
 911
 912 /* Like gfc_trans_code, but force creation of a BIND_EXPR around it.  */
 913
 914 static tree
 915 gfc_trans_omp_code (gfc_code *code, bool force_empty)
 916 {
 917   tree stmt;
 918
 919   pushlevel (0);
 920   stmt = gfc_trans_code (code);
 921   if (TREE_CODE (stmt) != BIND_EXPR)
 922     {
 923       if (!IS_EMPTY_STMT (stmt) || force_empty)
 924         {
 925           tree block = poplevel (1, 0, 0);
 926           stmt = build3_v (BIND_EXPR, NULL, stmt, block);
 927         }
 928       else
 929         poplevel (0, 0, 0);
 930     }
 931   else
 932     poplevel (0, 0, 0);
 933   return stmt;
 934 }
 935
 936
 937 static tree gfc_trans_omp_sections (gfc_code *, gfc_omp_clauses *);
 938 static tree gfc_trans_omp_workshare (gfc_code *, gfc_omp_clauses *);
 939
 940 static tree
 941 gfc_trans_omp_atomic (gfc_code *code)
 942 {
 943   gfc_se lse;
 944   gfc_se rse;
 945   gfc_expr *expr2, *e;
 946   gfc_symbol *var;
 947   stmtblock_t block;
 948   tree lhsaddr, type, rhs, x;
 949   enum tree_code op = ERROR_MARK;
 950   bool var_on_left = false;
 951
 952   code = code->block->next;
 953   gcc_assert (code->op == EXEC_ASSIGN);
 954   gcc_assert (code->next == NULL);
 955   var = code->expr1->symtree->n.sym;
 956
 957   gfc_init_se (&lse, NULL);
 958   gfc_init_se (&rse, NULL);
 959   gfc_start_block (&block);
 960
 961   gfc_conv_expr (&lse, code->expr1);
 962   gfc_add_block_to_block (&block, &lse.pre);
 963   type = TREE_TYPE (lse.expr);
 964   lhsaddr = gfc_build_addr_expr (NULL, lse.expr);
 965
 966   expr2 = code->expr2;
 967   if (expr2->expr_type == EXPR_FUNCTION
 968       && expr2->value.function.isym->id == GFC_ISYM_CONVERSION)
 969     expr2 = expr2->value.function.actual->expr;
 970
 971   if (expr2->expr_type == EXPR_OP)
 972     {
 973       gfc_expr *e;
 974       switch (expr2->value.op.op)
 975         {
 976         case INTRINSIC_PLUS:
 977           op = PLUS_EXPR;
 978           break;
 979         case INTRINSIC_TIMES:
 980           op = MULT_EXPR;
 981           break;
 982         case INTRINSIC_MINUS:
 983           op = MINUS_EXPR;
 984           break;
 985         case INTRINSIC_DIVIDE:
 986           if (expr2->ts.type == BT_INTEGER)
 987             op = TRUNC_DIV_EXPR;
 988           else
 989             op = RDIV_EXPR;
 990           break;
 991         case INTRINSIC_AND:
 992           op = TRUTH_ANDIF_EXPR;
 993           break;
 994         case INTRINSIC_OR:
 995           op = TRUTH_ORIF_EXPR;
 996           break;
 997         case INTRINSIC_EQV:
 998           op = EQ_EXPR;
 999           break;
1000         case INTRINSIC_NEQV:
1001           op = NE_EXPR;
1002           break;
1003         default:
1004           gcc_unreachable ();
1005         }
1006       e = expr2->value.op.op1;
1007       if (e->expr_type == EXPR_FUNCTION
1008           && e->value.function.isym->id == GFC_ISYM_CONVERSION)
1009         e = e->value.function.actual->expr;
1010       if (e->expr_type == EXPR_VARIABLE
1011           && e->symtree != NULL
1012           && e->symtree->n.sym == var)
1013         {
1014           expr2 = expr2->value.op.op2;
1015           var_on_left = true;
1016         }
1017       else
1018         {
1019           e = expr2->value.op.op2;
1020           if (e->expr_type == EXPR_FUNCTION
1021               && e->value.function.isym->id == GFC_ISYM_CONVERSION)
1022             e = e->value.function.actual->expr;
1023           gcc_assert (e->expr_type == EXPR_VARIABLE
1024                       && e->symtree != NULL
1025                       && e->symtree->n.sym == var);
1026           expr2 = expr2->value.op.op1;
1027           var_on_left = false;
1028         }
1029       gfc_conv_expr (&rse, expr2);
1030       gfc_add_block_to_block (&block, &rse.pre);
1031     }
1032   else
1033     {
1034       gcc_assert (expr2->expr_type == EXPR_FUNCTION);
1035       switch (expr2->value.function.isym->id)
1036         {
1037         case GFC_ISYM_MIN:
1038           op = MIN_EXPR;
1039           break;
1040         case GFC_ISYM_MAX:
1041           op = MAX_EXPR;
1042           break;
1043         case GFC_ISYM_IAND:
1044           op = BIT_AND_EXPR;
1045           break;
1046         case GFC_ISYM_IOR:
1047           op = BIT_IOR_EXPR;
1048           break;
1049         case GFC_ISYM_IEOR:
1050           op = BIT_XOR_EXPR;
1051           break;
1052         default:
1053           gcc_unreachable ();
1054         }
1055       e = expr2->value.function.actual->expr;
1056       gcc_assert (e->expr_type == EXPR_VARIABLE
1057                   && e->symtree != NULL
1058                   && e->symtree->n.sym == var);
1059
1060       gfc_conv_expr (&rse, expr2->value.function.actual->next->expr);
1061       gfc_add_block_to_block (&block, &rse.pre);
1062       if (expr2->value.function.actual->next->next != NULL)
1063         {
1064           tree accum = gfc_create_var (TREE_TYPE (rse.expr), NULL);
1065           gfc_actual_arglist *arg;
1066
1067           gfc_add_modify (&block, accum, rse.expr);
1068           for (arg = expr2->value.function.actual->next->next; arg;
1069                arg = arg->next)
1070             {
1071               gfc_init_block (&rse.pre);
1072               gfc_conv_expr (&rse, arg->expr);
1073               gfc_add_block_to_block (&block, &rse.pre);
1074               x = fold_build2 (op, TREE_TYPE (accum), accum, rse.expr);
1075               gfc_add_modify (&block, accum, x);
1076             }
1077
1078           rse.expr = accum;
1079         }
1080
1081       expr2 = expr2->value.function.actual->next->expr;
1082     }
1083
1084   lhsaddr = save_expr (lhsaddr);
1085   rhs = gfc_evaluate_now (rse.expr, &block);
1086   x = convert (TREE_TYPE (rhs), build_fold_indirect_ref (lhsaddr));
1087
1088   if (var_on_left)
1089     x = fold_build2 (op, TREE_TYPE (rhs), x, rhs);
1090   else
1091     x = fold_build2 (op, TREE_TYPE (rhs), rhs, x);
1092
1093   if (TREE_CODE (TREE_TYPE (rhs)) == COMPLEX_TYPE
1094       && TREE_CODE (type) != COMPLEX_TYPE)
1095     x = fold_build1 (REALPART_EXPR, TREE_TYPE (TREE_TYPE (rhs)), x);
1096
1097   x = build2_v (OMP_ATOMIC, lhsaddr, convert (type, x));
1098   gfc_add_expr_to_block (&block, x);
1099
1100   gfc_add_block_to_block (&block, &lse.pre);
1101   gfc_add_block_to_block (&block, &rse.pre);
1102
1103   return gfc_finish_block (&block);
1104 }
1105
1106 static tree
1107 gfc_trans_omp_barrier (void)
1108 {
1109   tree decl = built_in_decls [BUILT_IN_GOMP_BARRIER];
1110   return build_call_expr (decl, 0);
1111 }
1112
1113 static tree
1114 gfc_trans_omp_critical (gfc_code *code)
1115 {
1116   tree name = NULL_TREE, stmt;
1117   if (code->ext.omp_name != NULL)
1118     name = get_identifier (code->ext.omp_name);
1119   stmt = gfc_trans_code (code->block->next);
1120   return build2 (OMP_CRITICAL, void_type_node, stmt, name);
1121 }
1122
1123 static tree
1124 gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
1125                   gfc_omp_clauses *do_clauses, tree par_clauses)
1126 {
1127   gfc_se se;
1128   tree dovar, stmt, from, to, step, type, init, cond, incr;
1129   tree count = NULL_TREE, cycle_label, tmp, omp_clauses;
1130   stmtblock_t block;
1131   stmtblock_t body;
1132   gfc_omp_clauses *clauses = code->ext.omp_clauses;
1133   gfc_code *outermost;
1134   int i, collapse = clauses->collapse;
1135   tree dovar_init = NULL_TREE;
1136
1137   if (collapse <= 0)
1138     collapse = 1;
1139
1140   outermost = code = code->block->next;
1141   gcc_assert (code->op == EXEC_DO);
1142
1143   init = make_tree_vec (collapse);
1144   cond = make_tree_vec (collapse);
1145   incr = make_tree_vec (collapse);
1146
1147   if (pblock == NULL)
1148     {
1149       gfc_start_block (&block);
1150       pblock = &block;
1151     }
1152
1153   omp_clauses = gfc_trans_omp_clauses (pblock, do_clauses, code->loc);
1154
1155   for (i = 0; i < collapse; i++)
1156     {
1157       int simple = 0;
1158       int dovar_found = 0;
1159
1160       if (clauses)
1161         {
1162           gfc_namelist *n;
1163           for (n = clauses->lists[OMP_LIST_LASTPRIVATE]; n != NULL;
1164                n = n->next)
1165             if (code->ext.iterator->var->symtree->n.sym == n->sym)
1166               break;
1167           if (n != NULL)
1168             dovar_found = 1;
1169           else if (n == NULL)
1170             for (n = clauses->lists[OMP_LIST_PRIVATE]; n != NULL; n = n->next)
1171               if (code->ext.iterator->var->symtree->n.sym == n->sym)
1172                 break;
1173           if (n != NULL)
1174             dovar_found++;
1175         }
1176
1177       /* Evaluate all the expressions in the iterator.  */
1178       gfc_init_se (&se, NULL);
1179       gfc_conv_expr_lhs (&se, code->ext.iterator->var);
1180       gfc_add_block_to_block (pblock, &se.pre);
1181       dovar = se.expr;
1182       type = TREE_TYPE (dovar);
1183       gcc_assert (TREE_CODE (type) == INTEGER_TYPE);
1184
1185       gfc_init_se (&se, NULL);
1186       gfc_conv_expr_val (&se, code->ext.iterator->start);
1187       gfc_add_block_to_block (pblock, &se.pre);
1188       from = gfc_evaluate_now (se.expr, pblock);
1189
1190       gfc_init_se (&se, NULL);
1191       gfc_conv_expr_val (&se, code->ext.iterator->end);
1192       gfc_add_block_to_block (pblock, &se.pre);
1193       to = gfc_evaluate_now (se.expr, pblock);
1194
1195       gfc_init_se (&se, NULL);
1196       gfc_conv_expr_val (&se, code->ext.iterator->step);
1197       gfc_add_block_to_block (pblock, &se.pre);
1198       step = gfc_evaluate_now (se.expr, pblock);
1199
1200       /* Special case simple loops.  */
1201       if (integer_onep (step))
1202         simple = 1;
1203       else if (tree_int_cst_equal (step, integer_minus_one_node))
1204         simple = -1;
1205
1206       /* Loop body.  */
1207       if (simple)
1208         {
1209           TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, dovar, from);
1210           TREE_VEC_ELT (cond, i) = fold_build2 (simple > 0 ? LE_EXPR : GE_EXPR,
1211                                                 boolean_type_node, dovar, to);
1212           TREE_VEC_ELT (incr, i) = fold_build2 (PLUS_EXPR, type, dovar, step);
1213           TREE_VEC_ELT (incr, i) = fold_build2 (MODIFY_EXPR, type, dovar,
1214                                                 TREE_VEC_ELT (incr, i));
1215         }
1216       else
1217         {
1218           /* STEP is not 1 or -1.  Use:
1219              for (count = 0; count < (to + step - from) / step; count++)
1220                {
1221                  dovar = from + count * step;
1222                  body;
1223                cycle_label:;
1224                }  */
1225           tmp = fold_build2 (MINUS_EXPR, type, step, from);
1226           tmp = fold_build2 (PLUS_EXPR, type, to, tmp);
1227           tmp = fold_build2 (TRUNC_DIV_EXPR, type, tmp, step);
1228           tmp = gfc_evaluate_now (tmp, pblock);
1229           count = gfc_create_var (type, "count");
1230           TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, count,
1231                                              build_int_cst (type, 0));
1232           TREE_VEC_ELT (cond, i) = fold_build2 (LT_EXPR, boolean_type_node,
1233                                                 count, tmp);
1234           TREE_VEC_ELT (incr, i) = fold_build2 (PLUS_EXPR, type, count,
1235                                                 build_int_cst (type, 1));
1236           TREE_VEC_ELT (incr, i) = fold_build2 (MODIFY_EXPR, type,
1237                                                 count, TREE_VEC_ELT (incr, i));
1238
1239           /* Initialize DOVAR.  */
1240           tmp = fold_build2 (MULT_EXPR, type, count, step);
1241           tmp = fold_build2 (PLUS_EXPR, type, from, tmp);
1242           dovar_init = tree_cons (dovar, tmp, dovar_init);
1243         }
1244
1245       if (!dovar_found)
1246         {
1247           tmp = build_omp_clause (OMP_CLAUSE_PRIVATE);
1248           OMP_CLAUSE_DECL (tmp) = dovar;
1249           omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
1250         }
1251       else if (dovar_found == 2)
1252         {
1253           tree c = NULL;
1254
1255           tmp = NULL;
1256           if (!simple)
1257             {
1258               /* If dovar is lastprivate, but different counter is used,
1259                  dovar += step needs to be added to
1260                  OMP_CLAUSE_LASTPRIVATE_STMT, otherwise the copied dovar
1261                  will have the value on entry of the last loop, rather
1262                  than value after iterator increment.  */
1263               tmp = gfc_evaluate_now (step, pblock);
1264               tmp = fold_build2 (PLUS_EXPR, type, dovar, tmp);
1265               tmp = fold_build2 (MODIFY_EXPR, type, dovar, tmp);
1266               for (c = omp_clauses; c ; c = OMP_CLAUSE_CHAIN (c))
1267                 if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE
1268                     && OMP_CLAUSE_DECL (c) == dovar)
1269                   {
1270                     OMP_CLAUSE_LASTPRIVATE_STMT (c) = tmp;
1271                     break;
1272                   }
1273             }
1274           if (c == NULL && par_clauses != NULL)
1275             {
1276               for (c = par_clauses; c ; c = OMP_CLAUSE_CHAIN (c))
1277                 if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE
1278                     && OMP_CLAUSE_DECL (c) == dovar)
1279                   {
1280                     tree l = build_omp_clause (OMP_CLAUSE_LASTPRIVATE);
1281                     OMP_CLAUSE_DECL (l) = dovar;
1282                     OMP_CLAUSE_CHAIN (l) = omp_clauses;
1283                     OMP_CLAUSE_LASTPRIVATE_STMT (l) = tmp;
1284                     omp_clauses = l;
1285                     OMP_CLAUSE_SET_CODE (c, OMP_CLAUSE_SHARED);
1286                     break;
1287                   }
1288             }
1289           gcc_assert (simple || c != NULL);
1290         }
1291       if (!simple)
1292         {
1293           tmp = build_omp_clause (OMP_CLAUSE_PRIVATE);
1294           OMP_CLAUSE_DECL (tmp) = count;
1295           omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
1296         }
1297
1298       if (i + 1 < collapse)
1299         code = code->block->next;
1300     }
1301
1302   if (pblock != &block)
1303     {
1304       pushlevel (0);
1305       gfc_start_block (&block);
1306     }
1307
1308   gfc_start_block (&body);
1309
1310   dovar_init = nreverse (dovar_init);
1311   while (dovar_init)
1312     {
1313       gfc_add_modify (&body, TREE_PURPOSE (dovar_init),
1314                            TREE_VALUE (dovar_init));
1315       dovar_init = TREE_CHAIN (dovar_init);
1316     }
1317
1318   /* Cycle statement is implemented with a goto.  Exit statement must not be
1319      present for this loop.  */
1320   cycle_label = gfc_build_label_decl (NULL_TREE);
1321
1322   /* Put these labels where they can be found later. We put the
1323      labels in a TREE_LIST node (because TREE_CHAIN is already
1324      used). cycle_label goes in TREE_PURPOSE (backend_decl), exit
1325      label in TREE_VALUE (backend_decl).  */
1326
1327   code->block->backend_decl = tree_cons (cycle_label, NULL, NULL);
1328
1329   /* Main loop body.  */
1330   tmp = gfc_trans_omp_code (code->block->next, true);
1331   gfc_add_expr_to_block (&body, tmp);
1332
1333   /* Label for cycle statements (if needed).  */
1334   if (TREE_USED (cycle_label))
1335     {
1336       tmp = build1_v (LABEL_EXPR, cycle_label);
1337       gfc_add_expr_to_block (&body, tmp);
1338     }
1339
1340   /* End of loop body.  */
1341   stmt = make_node (OMP_FOR);
1342
1343   TREE_TYPE (stmt) = void_type_node;
1344   OMP_FOR_BODY (stmt) = gfc_finish_block (&body);
1345   OMP_FOR_CLAUSES (stmt) = omp_clauses;
1346   OMP_FOR_INIT (stmt) = init;
1347   OMP_FOR_COND (stmt) = cond;
1348   OMP_FOR_INCR (stmt) = incr;
1349   gfc_add_expr_to_block (&block, stmt);
1350
1351   return gfc_finish_block (&block);
1352 }
1353
1354 static tree
1355 gfc_trans_omp_flush (void)
1356 {
1357   tree decl = built_in_decls [BUILT_IN_SYNCHRONIZE];
1358   return build_call_expr (decl, 0);
1359 }
1360
1361 static tree
1362 gfc_trans_omp_master (gfc_code *code)
1363 {
1364   tree stmt = gfc_trans_code (code->block->next);
1365   if (IS_EMPTY_STMT (stmt))
1366     return stmt;
1367   return build1_v (OMP_MASTER, stmt);
1368 }
1369
1370 static tree
1371 gfc_trans_omp_ordered (gfc_code *code)
1372 {
1373   return build1_v (OMP_ORDERED, gfc_trans_code (code->block->next));
1374 }
1375
1376 static tree
1377 gfc_trans_omp_parallel (gfc_code *code)
1378 {
1379   stmtblock_t block;
1380   tree stmt, omp_clauses;
1381
1382   gfc_start_block (&block);
1383   omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
1384                                        code->loc);
1385   stmt = gfc_trans_omp_code (code->block->next, true);
1386   stmt = build2 (OMP_PARALLEL, void_type_node, stmt, omp_clauses);
1387   gfc_add_expr_to_block (&block, stmt);
1388   return gfc_finish_block (&block);
1389 }
1390
1391 static tree
1392 gfc_trans_omp_parallel_do (gfc_code *code)
1393 {
1394   stmtblock_t block, *pblock = NULL;
1395   gfc_omp_clauses parallel_clauses, do_clauses;
1396   tree stmt, omp_clauses = NULL_TREE;
1397
1398   gfc_start_block (&block);
1399
1400   memset (&do_clauses, 0, sizeof (do_clauses));
1401   if (code->ext.omp_clauses != NULL)
1402     {
1403       memcpy (&parallel_clauses, code->ext.omp_clauses,
1404               sizeof (parallel_clauses));
1405       do_clauses.sched_kind = parallel_clauses.sched_kind;
1406       do_clauses.chunk_size = parallel_clauses.chunk_size;
1407       do_clauses.ordered = parallel_clauses.ordered;
1408       do_clauses.collapse = parallel_clauses.collapse;
1409       parallel_clauses.sched_kind = OMP_SCHED_NONE;
1410       parallel_clauses.chunk_size = NULL;
1411       parallel_clauses.ordered = false;
1412       parallel_clauses.collapse = 0;
1413       omp_clauses = gfc_trans_omp_clauses (&block, &parallel_clauses,
1414                                            code->loc);
1415     }
1416   do_clauses.nowait = true;
1417   if (!do_clauses.ordered && do_clauses.sched_kind != OMP_SCHED_STATIC)
1418     pblock = &block;
1419   else
1420     pushlevel (0);
1421   stmt = gfc_trans_omp_do (code, pblock, &do_clauses, omp_clauses);
1422   if (TREE_CODE (stmt) != BIND_EXPR)
1423     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
1424   else
1425     poplevel (0, 0, 0);
1426   stmt = build2 (OMP_PARALLEL, void_type_node, stmt, omp_clauses);
1427   OMP_PARALLEL_COMBINED (stmt) = 1;
1428   gfc_add_expr_to_block (&block, stmt);
1429   return gfc_finish_block (&block);
1430 }
1431
1432 static tree
1433 gfc_trans_omp_parallel_sections (gfc_code *code)
1434 {
1435   stmtblock_t block;
1436   gfc_omp_clauses section_clauses;
1437   tree stmt, omp_clauses;
1438
1439   memset (&section_clauses, 0, sizeof (section_clauses));
1440   section_clauses.nowait = true;
1441
1442   gfc_start_block (&block);
1443   omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
1444                                        code->loc);
1445   pushlevel (0);
1446   stmt = gfc_trans_omp_sections (code, &section_clauses);
1447   if (TREE_CODE (stmt) != BIND_EXPR)
1448     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
1449   else
1450     poplevel (0, 0, 0);
1451   stmt = build2 (OMP_PARALLEL, void_type_node, stmt, omp_clauses);
1452   OMP_PARALLEL_COMBINED (stmt) = 1;
1453   gfc_add_expr_to_block (&block, stmt);
1454   return gfc_finish_block (&block);
1455 }
1456
1457 static tree
1458 gfc_trans_omp_parallel_workshare (gfc_code *code)
1459 {
1460   stmtblock_t block;
1461   gfc_omp_clauses workshare_clauses;
1462   tree stmt, omp_clauses;
1463
1464   memset (&workshare_clauses, 0, sizeof (workshare_clauses));
1465   workshare_clauses.nowait = true;
1466
1467   gfc_start_block (&block);
1468   omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
1469                                        code->loc);
1470   pushlevel (0);
1471   stmt = gfc_trans_omp_workshare (code, &workshare_clauses);
1472   if (TREE_CODE (stmt) != BIND_EXPR)
1473     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
1474   else
1475     poplevel (0, 0, 0);
1476   stmt = build2 (OMP_PARALLEL, void_type_node, stmt, omp_clauses);
1477   OMP_PARALLEL_COMBINED (stmt) = 1;
1478   gfc_add_expr_to_block (&block, stmt);
1479   return gfc_finish_block (&block);
1480 }
1481
1482 static tree
1483 gfc_trans_omp_sections (gfc_code *code, gfc_omp_clauses *clauses)
1484 {
1485   stmtblock_t block, body;
1486   tree omp_clauses, stmt;
1487   bool has_lastprivate = clauses->lists[OMP_LIST_LASTPRIVATE] != NULL;
1488
1489   gfc_start_block (&block);
1490
1491   omp_clauses = gfc_trans_omp_clauses (&block, clauses, code->loc);
1492
1493   gfc_init_block (&body);
1494   for (code = code->block; code; code = code->block)
1495     {
1496       /* Last section is special because of lastprivate, so even if it
1497          is empty, chain it in.  */
1498       stmt = gfc_trans_omp_code (code->next,
1499                                  has_lastprivate && code->block == NULL);
1500       if (! IS_EMPTY_STMT (stmt))
1501         {
1502           stmt = build1_v (OMP_SECTION, stmt);
1503           gfc_add_expr_to_block (&body, stmt);
1504         }
1505     }
1506   stmt = gfc_finish_block (&body);
1507
1508   stmt = build2 (OMP_SECTIONS, void_type_node, stmt, omp_clauses);
1509   gfc_add_expr_to_block (&block, stmt);
1510
1511   return gfc_finish_block (&block);
1512 }
1513
1514 static tree
1515 gfc_trans_omp_single (gfc_code *code, gfc_omp_clauses *clauses)
1516 {
1517   tree omp_clauses = gfc_trans_omp_clauses (NULL, clauses, code->loc);
1518   tree stmt = gfc_trans_omp_code (code->block->next, true);
1519   stmt = build2 (OMP_SINGLE, void_type_node, stmt, omp_clauses);
1520   return stmt;
1521 }
1522
1523 static tree
1524 gfc_trans_omp_task (gfc_code *code)
1525 {
1526   stmtblock_t block;
1527   tree stmt, omp_clauses;
1528
1529   gfc_start_block (&block);
1530   omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
1531                                        code->loc);
1532   stmt = gfc_trans_omp_code (code->block->next, true);
1533   stmt = build2 (OMP_TASK, void_type_node, stmt, omp_clauses);
1534   gfc_add_expr_to_block (&block, stmt);
1535   return gfc_finish_block (&block);
1536 }
1537
1538 static tree
1539 gfc_trans_omp_taskwait (void)
1540 {
1541   tree decl = built_in_decls [BUILT_IN_GOMP_TASKWAIT];
1542   return build_call_expr (decl, 0);
1543 }
1544
1545 static tree
1546 gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses)
1547 {
1548   tree res, tmp, stmt;
1549   stmtblock_t block, *pblock = NULL;
1550   stmtblock_t singleblock;
1551   int saved_ompws_flags;
1552   bool singleblock_in_progress = false;
1553   /* True if previous gfc_code in workshare construct is not workshared.  */
1554   bool prev_singleunit;
1555
1556   code = code->block->next;
1557
1558   pushlevel (0);
1559
1560   if (!code)
1561     return build_empty_stmt ();
1562
1563   gfc_start_block (&block);
1564   pblock = &block;
1565
1566   ompws_flags = OMPWS_WORKSHARE_FLAG;
1567   prev_singleunit = false;
1568
1569   /* Translate statements one by one to trees until we reach
1570      the end of the workshare construct.  Adjacent gfc_codes that
1571      are a single unit of work are clustered and encapsulated in a
1572      single OMP_SINGLE construct.  */
1573   for (; code; code = code->next)
1574     {
1575       if (code->here != 0)
1576         {
1577           res = gfc_trans_label_here (code);
1578           gfc_add_expr_to_block (pblock, res);
1579         }
1580
1581       /* No dependence analysis, use for clauses with wait.
1582          If this is the last gfc_code, use default omp_clauses.  */
1583       if (code->next == NULL && clauses->nowait)
1584         ompws_flags |= OMPWS_NOWAIT;
1585
1586       /* By default, every gfc_code is a single unit of work.  */
1587       ompws_flags |= OMPWS_CURR_SINGLEUNIT;
1588       ompws_flags &= ~OMPWS_SCALARIZER_WS;
1589
1590       switch (code->op)
1591         {
1592         case EXEC_NOP:
1593           res = NULL_TREE;
1594           break;
1595
1596         case EXEC_ASSIGN:
1597           res = gfc_trans_assign (code);
1598           break;
1599
1600         case EXEC_POINTER_ASSIGN:
1601           res = gfc_trans_pointer_assign (code);
1602           break;
1603
1604         case EXEC_INIT_ASSIGN:
1605           res = gfc_trans_init_assign (code);
1606           break;
1607
1608         case EXEC_FORALL:
1609           res = gfc_trans_forall (code);
1610           break;
1611
1612         case EXEC_WHERE:
1613           res = gfc_trans_where (code);
1614           break;
1615
1616         case EXEC_OMP_ATOMIC:
1617           res = gfc_trans_omp_directive (code);
1618           break;
1619
1620         case EXEC_OMP_PARALLEL:
1621         case EXEC_OMP_PARALLEL_DO:
1622         case EXEC_OMP_PARALLEL_SECTIONS:
1623         case EXEC_OMP_PARALLEL_WORKSHARE:
1624         case EXEC_OMP_CRITICAL:
1625           saved_ompws_flags = ompws_flags;
1626           ompws_flags = 0;
1627           res = gfc_trans_omp_directive (code);
1628           ompws_flags = saved_ompws_flags;
1629           break;
1630
1631         default:
1632           internal_error ("gfc_trans_omp_workshare(): Bad statement code");
1633         }
1634
1635       gfc_set_backend_locus (&code->loc);
1636
1637       if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
1638         {
1639           if (TREE_CODE (res) == STATEMENT_LIST)
1640             tree_annotate_all_with_location (&res, input_location);
1641           else
1642             SET_EXPR_LOCATION (res, input_location);
1643
1644           if (prev_singleunit)
1645             {
1646               if (ompws_flags & OMPWS_CURR_SINGLEUNIT)
1647                 /* Add current gfc_code to single block.  */
1648                 gfc_add_expr_to_block (&singleblock, res);
1649               else
1650                 {
1651                   /* Finish single block and add it to pblock.  */
1652                   tmp = gfc_finish_block (&singleblock);
1653                   tmp = build2 (OMP_SINGLE, void_type_node, tmp, NULL_TREE);
1654                   gfc_add_expr_to_block (pblock, tmp);
1655                   /* Add current gfc_code to pblock.  */
1656                   gfc_add_expr_to_block (pblock, res);
1657                   singleblock_in_progress = false;
1658                 }
1659             }
1660           else
1661             {
1662               if (ompws_flags & OMPWS_CURR_SINGLEUNIT)
1663                 {
1664                   /* Start single block.  */
1665                   gfc_init_block (&singleblock);
1666                   gfc_add_expr_to_block (&singleblock, res);
1667                   singleblock_in_progress = true;
1668                 }
1669               else
1670                 /* Add the new statement to the block.  */
1671                 gfc_add_expr_to_block (pblock, res);
1672             }
1673           prev_singleunit = (ompws_flags & OMPWS_CURR_SINGLEUNIT) != 0;
1674         }
1675     }
1676
1677   /* Finish remaining SINGLE block, if we were in the middle of one.  */
1678   if (singleblock_in_progress)
1679     {
1680       /* Finish single block and add it to pblock.  */
1681       tmp = gfc_finish_block (&singleblock);
1682       tmp = build2 (OMP_SINGLE, void_type_node, tmp,
1683                     clauses->nowait
1684                     ? build_omp_clause (OMP_CLAUSE_NOWAIT) : NULL_TREE);
1685       gfc_add_expr_to_block (pblock, tmp);
1686     }
1687
1688   stmt = gfc_finish_block (pblock);
1689   if (TREE_CODE (stmt) != BIND_EXPR)
1690     {
1691       if (!IS_EMPTY_STMT (stmt))
1692         {
1693           tree bindblock = poplevel (1, 0, 0);
1694           stmt = build3_v (BIND_EXPR, NULL, stmt, bindblock);
1695         }
1696       else
1697         poplevel (0, 0, 0);
1698     }
1699   else
1700     poplevel (0, 0, 0);
1701
1702   ompws_flags = 0;
1703   return stmt;
1704 }
1705
1706 tree
1707 gfc_trans_omp_directive (gfc_code *code)
1708 {
1709   switch (code->op)
1710     {
1711     case EXEC_OMP_ATOMIC:
1712       return gfc_trans_omp_atomic (code);
1713     case EXEC_OMP_BARRIER:
1714       return gfc_trans_omp_barrier ();
1715     case EXEC_OMP_CRITICAL:
1716       return gfc_trans_omp_critical (code);
1717     case EXEC_OMP_DO:
1718       return gfc_trans_omp_do (code, NULL, code->ext.omp_clauses, NULL);
1719     case EXEC_OMP_FLUSH:
1720       return gfc_trans_omp_flush ();
1721     case EXEC_OMP_MASTER:
1722       return gfc_trans_omp_master (code);
1723     case EXEC_OMP_ORDERED:
1724       return gfc_trans_omp_ordered (code);
1725     case EXEC_OMP_PARALLEL:
1726       return gfc_trans_omp_parallel (code);
1727     case EXEC_OMP_PARALLEL_DO:
1728       return gfc_trans_omp_parallel_do (code);
1729     case EXEC_OMP_PARALLEL_SECTIONS:
1730       return gfc_trans_omp_parallel_sections (code);
1731     case EXEC_OMP_PARALLEL_WORKSHARE:
1732       return gfc_trans_omp_parallel_workshare (code);
1733     case EXEC_OMP_SECTIONS:
1734       return gfc_trans_omp_sections (code, code->ext.omp_clauses);
1735     case EXEC_OMP_SINGLE:
1736       return gfc_trans_omp_single (code, code->ext.omp_clauses);
1737     case EXEC_OMP_TASK:
1738       return gfc_trans_omp_task (code);
1739     case EXEC_OMP_TASKWAIT:
1740       return gfc_trans_omp_taskwait ();
1741     case EXEC_OMP_WORKSHARE:
1742       return gfc_trans_omp_workshare (code, code->ext.omp_clauses);
1743     default:
1744       gcc_unreachable ();
1745     }
1746 }