gcc/fortran/trans-openmp.c

   1 /* OpenMP directive translation -- generate GCC trees from gfc_code.
   2    Copyright (C) 2005, 2006, 2007 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 "tree-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
  39 /* True if OpenMP should privatize what this DECL points to rather
  40    than the DECL itself.  */
  41
  42 bool
  43 gfc_omp_privatize_by_reference (tree decl)
  44 {
  45   tree type = TREE_TYPE (decl);
  46
  47   if (TREE_CODE (type) == REFERENCE_TYPE)
  48     return true;
  49
  50   if (TREE_CODE (type) == POINTER_TYPE)
  51     {
  52       /* Array POINTER/ALLOCATABLE have aggregate types, all user variables
  53          that have POINTER_TYPE type and don't have GFC_POINTER_TYPE_P
  54          set are supposed to be privatized by reference.  */
  55       if (GFC_POINTER_TYPE_P (type))
  56         return false;
  57
  58       if (!DECL_ARTIFICIAL (decl))
  59         return true;
  60
  61       /* Some arrays are expanded as DECL_ARTIFICIAL pointers
  62          by the frontend.  */
  63       if (DECL_LANG_SPECIFIC (decl)
  64           && GFC_DECL_SAVED_DESCRIPTOR (decl))
  65         return true;
  66     }
  67
  68   return false;
  69 }
  70
  71 /* True if OpenMP sharing attribute of DECL is predetermined.  */
  72
  73 enum omp_clause_default_kind
  74 gfc_omp_predetermined_sharing (tree decl)
  75 {
  76   if (DECL_ARTIFICIAL (decl) && ! GFC_DECL_RESULT (decl))
  77     return OMP_CLAUSE_DEFAULT_SHARED;
  78
  79   /* Cray pointees shouldn't be listed in any clauses and should be
  80      gimplified to dereference of the corresponding Cray pointer.
  81      Make them all private, so that they are emitted in the debug
  82      information.  */
  83   if (GFC_DECL_CRAY_POINTEE (decl))
  84     return OMP_CLAUSE_DEFAULT_PRIVATE;
  85
  86   /* COMMON and EQUIVALENCE decls are shared.  They
  87      are only referenced through DECL_VALUE_EXPR of the variables
  88      contained in them.  If those are privatized, they will not be
  89      gimplified to the COMMON or EQUIVALENCE decls.  */
  90   if (GFC_DECL_COMMON_OR_EQUIV (decl) && ! DECL_HAS_VALUE_EXPR_P (decl))
  91     return OMP_CLAUSE_DEFAULT_SHARED;
  92
  93   if (GFC_DECL_RESULT (decl) && ! DECL_HAS_VALUE_EXPR_P (decl))
  94     return OMP_CLAUSE_DEFAULT_SHARED;
  95
  96   return OMP_CLAUSE_DEFAULT_UNSPECIFIED;
  97 }
  98
  99
 100 /* Return code to initialize DECL with its default constructor, or
 101    NULL if there's nothing to do.  */
 102
 103 tree
 104 gfc_omp_clause_default_ctor (tree clause ATTRIBUTE_UNUSED, tree decl)
 105 {
 106   tree type = TREE_TYPE (decl);
 107   stmtblock_t block;
 108
 109   if (! GFC_DESCRIPTOR_TYPE_P (type))
 110     return NULL;
 111
 112   /* Allocatable arrays in PRIVATE clauses need to be set to
 113      "not currently allocated" allocation status.  */
 114   gfc_init_block (&block);
 115
 116   gfc_conv_descriptor_data_set_tuples (&block, decl, null_pointer_node);
 117
 118   return gfc_finish_block (&block);
 119 }
 120
 121
 122 /* Return true if DECL's DECL_VALUE_EXPR (if any) should be
 123    disregarded in OpenMP construct, because it is going to be
 124    remapped during OpenMP lowering.  SHARED is true if DECL
 125    is going to be shared, false if it is going to be privatized.  */
 126
 127 bool
 128 gfc_omp_disregard_value_expr (tree decl, bool shared)
 129 {
 130   if (GFC_DECL_COMMON_OR_EQUIV (decl)
 131       && DECL_HAS_VALUE_EXPR_P (decl))
 132     {
 133       tree value = DECL_VALUE_EXPR (decl);
 134
 135       if (TREE_CODE (value) == COMPONENT_REF
 136           && TREE_CODE (TREE_OPERAND (value, 0)) == VAR_DECL
 137           && GFC_DECL_COMMON_OR_EQUIV (TREE_OPERAND (value, 0)))
 138         {
 139           /* If variable in COMMON or EQUIVALENCE is privatized, return
 140              true, as just that variable is supposed to be privatized,
 141              not the whole COMMON or whole EQUIVALENCE.
 142              For shared variables in COMMON or EQUIVALENCE, let them be
 143              gimplified to DECL_VALUE_EXPR, so that for multiple shared vars
 144              from the same COMMON or EQUIVALENCE just one sharing of the
 145              whole COMMON or EQUIVALENCE is enough.  */
 146           return ! shared;
 147         }
 148     }
 149
 150   if (GFC_DECL_RESULT (decl) && DECL_HAS_VALUE_EXPR_P (decl))
 151     return ! shared;
 152
 153   return false;
 154 }
 155
 156 /* Return true if DECL that is shared iff SHARED is true should
 157    be put into OMP_CLAUSE_PRIVATE with OMP_CLAUSE_PRIVATE_DEBUG
 158    flag set.  */
 159
 160 bool
 161 gfc_omp_private_debug_clause (tree decl, bool shared)
 162 {
 163   if (GFC_DECL_CRAY_POINTEE (decl))
 164     return true;
 165
 166   if (GFC_DECL_COMMON_OR_EQUIV (decl)
 167       && DECL_HAS_VALUE_EXPR_P (decl))
 168     {
 169       tree value = DECL_VALUE_EXPR (decl);
 170
 171       if (TREE_CODE (value) == COMPONENT_REF
 172           && TREE_CODE (TREE_OPERAND (value, 0)) == VAR_DECL
 173           && GFC_DECL_COMMON_OR_EQUIV (TREE_OPERAND (value, 0)))
 174         return shared;
 175     }
 176
 177   return false;
 178 }
 179
 180 /* Register language specific type size variables as potentially OpenMP
 181    firstprivate variables.  */
 182
 183 void
 184 gfc_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *ctx, tree type)
 185 {
 186   if (GFC_ARRAY_TYPE_P (type) || GFC_DESCRIPTOR_TYPE_P (type))
 187     {
 188       int r;
 189
 190       gcc_assert (TYPE_LANG_SPECIFIC (type) != NULL);
 191       for (r = 0; r < GFC_TYPE_ARRAY_RANK (type); r++)
 192         {
 193           omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_LBOUND (type, r));
 194           omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_UBOUND (type, r));
 195           omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_STRIDE (type, r));
 196         }
 197       omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_SIZE (type));
 198       omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_OFFSET (type));
 199     }
 200 }
 201
 202
 203 static inline tree
 204 gfc_trans_add_clause (tree node, tree tail)
 205 {
 206   OMP_CLAUSE_CHAIN (node) = tail;
 207   return node;
 208 }
 209
 210 static tree
 211 gfc_trans_omp_variable (gfc_symbol *sym)
 212 {
 213   tree t = gfc_get_symbol_decl (sym);
 214   tree parent_decl;
 215   int parent_flag;
 216   bool return_value;
 217   bool alternate_entry;
 218   bool entry_master;
 219
 220   return_value = sym->attr.function && sym->result == sym;
 221   alternate_entry = sym->attr.function && sym->attr.entry
 222                     && sym->result == sym;
 223   entry_master = sym->attr.result
 224                  && sym->ns->proc_name->attr.entry_master
 225                  && !gfc_return_by_reference (sym->ns->proc_name);
 226   parent_decl = DECL_CONTEXT (current_function_decl);
 227
 228   if ((t == parent_decl && return_value)
 229        || (sym->ns && sym->ns->proc_name
 230            && sym->ns->proc_name->backend_decl == parent_decl
 231            && (alternate_entry || entry_master)))
 232     parent_flag = 1;
 233   else
 234     parent_flag = 0;
 235
 236   /* Special case for assigning the return value of a function.
 237      Self recursive functions must have an explicit return value.  */
 238   if (return_value && (t == current_function_decl || parent_flag))
 239     t = gfc_get_fake_result_decl (sym, parent_flag);
 240
 241   /* Similarly for alternate entry points.  */
 242   else if (alternate_entry
 243            && (sym->ns->proc_name->backend_decl == current_function_decl
 244                || parent_flag))
 245     {
 246       gfc_entry_list *el = NULL;
 247
 248       for (el = sym->ns->entries; el; el = el->next)
 249         if (sym == el->sym)
 250           {
 251             t = gfc_get_fake_result_decl (sym, parent_flag);
 252             break;
 253           }
 254     }
 255
 256   else if (entry_master
 257            && (sym->ns->proc_name->backend_decl == current_function_decl
 258                || parent_flag))
 259     t = gfc_get_fake_result_decl (sym, parent_flag);
 260
 261   return t;
 262 }
 263
 264 static tree
 265 gfc_trans_omp_variable_list (enum omp_clause_code code, gfc_namelist *namelist,
 266                              tree list)
 267 {
 268   for (; namelist != NULL; namelist = namelist->next)
 269     if (namelist->sym->attr.referenced)
 270       {
 271         tree t = gfc_trans_omp_variable (namelist->sym);
 272         if (t != error_mark_node)
 273           {
 274             tree node = build_omp_clause (code);
 275             OMP_CLAUSE_DECL (node) = t;
 276             list = gfc_trans_add_clause (node, list);
 277           }
 278       }
 279   return list;
 280 }
 281
 282 static void
 283 gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
 284 {
 285   gfc_symtree *root1 = NULL, *root2 = NULL, *root3 = NULL, *root4 = NULL;
 286   gfc_symtree *symtree1, *symtree2, *symtree3, *symtree4 = NULL;
 287   gfc_symbol init_val_sym, outer_sym, intrinsic_sym;
 288   gfc_expr *e1, *e2, *e3, *e4;
 289   gfc_ref *ref;
 290   tree decl, backend_decl, stmt;
 291   locus old_loc = gfc_current_locus;
 292   const char *iname;
 293   try t;
 294
 295   decl = OMP_CLAUSE_DECL (c);
 296   gfc_current_locus = where;
 297
 298   /* Create a fake symbol for init value.  */
 299   memset (&init_val_sym, 0, sizeof (init_val_sym));
 300   init_val_sym.ns = sym->ns;
 301   init_val_sym.name = sym->name;
 302   init_val_sym.ts = sym->ts;
 303   init_val_sym.attr.referenced = 1;
 304   init_val_sym.declared_at = where;
 305   init_val_sym.attr.flavor = FL_VARIABLE;
 306   backend_decl = omp_reduction_init (c, gfc_sym_type (&init_val_sym));
 307   init_val_sym.backend_decl = backend_decl;
 308
 309   /* Create a fake symbol for the outer array reference.  */
 310   outer_sym = *sym;
 311   outer_sym.as = gfc_copy_array_spec (sym->as);
 312   outer_sym.attr.dummy = 0;
 313   outer_sym.attr.result = 0;
 314   outer_sym.attr.flavor = FL_VARIABLE;
 315   outer_sym.backend_decl = create_tmp_var_raw (TREE_TYPE (decl), NULL);
 316
 317   /* Create fake symtrees for it.  */
 318   symtree1 = gfc_new_symtree (&root1, sym->name);
 319   symtree1->n.sym = sym;
 320   gcc_assert (symtree1 == root1);
 321
 322   symtree2 = gfc_new_symtree (&root2, sym->name);
 323   symtree2->n.sym = &init_val_sym;
 324   gcc_assert (symtree2 == root2);
 325
 326   symtree3 = gfc_new_symtree (&root3, sym->name);
 327   symtree3->n.sym = &outer_sym;
 328   gcc_assert (symtree3 == root3);
 329
 330   /* Create expressions.  */
 331   e1 = gfc_get_expr ();
 332   e1->expr_type = EXPR_VARIABLE;
 333   e1->where = where;
 334   e1->symtree = symtree1;
 335   e1->ts = sym->ts;
 336   e1->ref = ref = gfc_get_ref ();
 337   ref->u.ar.where = where;
 338   ref->u.ar.as = sym->as;
 339   ref->u.ar.type = AR_FULL;
 340   ref->u.ar.dimen = 0;
 341   t = gfc_resolve_expr (e1);
 342   gcc_assert (t == SUCCESS);
 343
 344   e2 = gfc_get_expr ();
 345   e2->expr_type = EXPR_VARIABLE;
 346   e2->where = where;
 347   e2->symtree = symtree2;
 348   e2->ts = sym->ts;
 349   t = gfc_resolve_expr (e2);
 350   gcc_assert (t == SUCCESS);
 351
 352   e3 = gfc_copy_expr (e1);
 353   e3->symtree = symtree3;
 354   t = gfc_resolve_expr (e3);
 355   gcc_assert (t == SUCCESS);
 356
 357   iname = NULL;
 358   switch (OMP_CLAUSE_REDUCTION_CODE (c))
 359     {
 360     case PLUS_EXPR:
 361     case MINUS_EXPR:
 362       e4 = gfc_add (e3, e1);
 363       break;
 364     case MULT_EXPR:
 365       e4 = gfc_multiply (e3, e1);
 366       break;
 367     case TRUTH_ANDIF_EXPR:
 368       e4 = gfc_and (e3, e1);
 369       break;
 370     case TRUTH_ORIF_EXPR:
 371       e4 = gfc_or (e3, e1);
 372       break;
 373     case EQ_EXPR:
 374       e4 = gfc_eqv (e3, e1);
 375       break;
 376     case NE_EXPR:
 377       e4 = gfc_neqv (e3, e1);
 378       break;
 379     case MIN_EXPR:
 380       iname = "min";
 381       break;
 382     case MAX_EXPR:
 383       iname = "max";
 384       break;
 385     case BIT_AND_EXPR:
 386       iname = "iand";
 387       break;
 388     case BIT_IOR_EXPR:
 389       iname = "ior";
 390       break;
 391     case BIT_XOR_EXPR:
 392       iname = "ieor";
 393       break;
 394     default:
 395       gcc_unreachable ();
 396     }
 397   if (iname != NULL)
 398     {
 399       memset (&intrinsic_sym, 0, sizeof (intrinsic_sym));
 400       intrinsic_sym.ns = sym->ns;
 401       intrinsic_sym.name = iname;
 402       intrinsic_sym.ts = sym->ts;
 403       intrinsic_sym.attr.referenced = 1;
 404       intrinsic_sym.attr.intrinsic = 1;
 405       intrinsic_sym.attr.function = 1;
 406       intrinsic_sym.result = &intrinsic_sym;
 407       intrinsic_sym.declared_at = where;
 408
 409       symtree4 = gfc_new_symtree (&root4, iname);
 410       symtree4->n.sym = &intrinsic_sym;
 411       gcc_assert (symtree4 == root4);
 412
 413       e4 = gfc_get_expr ();
 414       e4->expr_type = EXPR_FUNCTION;
 415       e4->where = where;
 416       e4->symtree = symtree4;
 417       e4->value.function.isym = gfc_find_function (iname);
 418       e4->value.function.actual = gfc_get_actual_arglist ();
 419       e4->value.function.actual->expr = e3;
 420       e4->value.function.actual->next = gfc_get_actual_arglist ();
 421       e4->value.function.actual->next->expr = e1;
 422     }
 423   /* e1 and e3 have been stored as arguments of e4, avoid sharing.  */
 424   e1 = gfc_copy_expr (e1);
 425   e3 = gfc_copy_expr (e3);
 426   t = gfc_resolve_expr (e4);
 427   gcc_assert (t == SUCCESS);
 428
 429   /* Create the init statement list.  */
 430   pushlevel (0);
 431   stmt = gfc_trans_assignment (e1, e2, false);
 432   if (TREE_CODE (stmt) != BIND_EXPR)
 433     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
 434   else
 435     poplevel (0, 0, 0);
 436   OMP_CLAUSE_REDUCTION_INIT (c) = stmt;
 437
 438   /* Create the merge statement list.  */
 439   pushlevel (0);
 440   stmt = gfc_trans_assignment (e3, e4, false);
 441   if (TREE_CODE (stmt) != BIND_EXPR)
 442     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
 443   else
 444     poplevel (0, 0, 0);
 445   OMP_CLAUSE_REDUCTION_MERGE (c) = stmt;
 446
 447   /* And stick the placeholder VAR_DECL into the clause as well.  */
 448   OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) = outer_sym.backend_decl;
 449
 450   gfc_current_locus = old_loc;
 451
 452   gfc_free_expr (e1);
 453   gfc_free_expr (e2);
 454   gfc_free_expr (e3);
 455   gfc_free_expr (e4);
 456   gfc_free (symtree1);
 457   gfc_free (symtree2);
 458   gfc_free (symtree3);
 459   if (symtree4)
 460     gfc_free (symtree4);
 461   gfc_free_array_spec (outer_sym.as);
 462 }
 463
 464 static tree
 465 gfc_trans_omp_reduction_list (gfc_namelist *namelist, tree list,
 466                               enum tree_code reduction_code, locus where)
 467 {
 468   for (; namelist != NULL; namelist = namelist->next)
 469     if (namelist->sym->attr.referenced)
 470       {
 471         tree t = gfc_trans_omp_variable (namelist->sym);
 472         if (t != error_mark_node)
 473           {
 474             tree node = build_omp_clause (OMP_CLAUSE_REDUCTION);
 475             OMP_CLAUSE_DECL (node) = t;
 476             OMP_CLAUSE_REDUCTION_CODE (node) = reduction_code;
 477             if (namelist->sym->attr.dimension)
 478               gfc_trans_omp_array_reduction (node, namelist->sym, where);
 479             list = gfc_trans_add_clause (node, list);
 480           }
 481       }
 482   return list;
 483 }
 484
 485 static tree
 486 gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 487                        locus where)
 488 {
 489   tree omp_clauses = NULL_TREE, chunk_size, c, old_clauses;
 490   int list;
 491   enum omp_clause_code clause_code;
 492   gfc_se se;
 493
 494   if (clauses == NULL)
 495     return NULL_TREE;
 496
 497   for (list = 0; list < OMP_LIST_NUM; list++)
 498     {
 499       gfc_namelist *n = clauses->lists[list];
 500
 501       if (n == NULL)
 502         continue;
 503       if (list >= OMP_LIST_REDUCTION_FIRST
 504           && list <= OMP_LIST_REDUCTION_LAST)
 505         {
 506           enum tree_code reduction_code;
 507           switch (list)
 508             {
 509             case OMP_LIST_PLUS:
 510               reduction_code = PLUS_EXPR;
 511               break;
 512             case OMP_LIST_MULT:
 513               reduction_code = MULT_EXPR;
 514               break;
 515             case OMP_LIST_SUB:
 516               reduction_code = MINUS_EXPR;
 517               break;
 518             case OMP_LIST_AND:
 519               reduction_code = TRUTH_ANDIF_EXPR;
 520               break;
 521             case OMP_LIST_OR:
 522               reduction_code = TRUTH_ORIF_EXPR;
 523               break;
 524             case OMP_LIST_EQV:
 525               reduction_code = EQ_EXPR;
 526               break;
 527             case OMP_LIST_NEQV:
 528               reduction_code = NE_EXPR;
 529               break;
 530             case OMP_LIST_MAX:
 531               reduction_code = MAX_EXPR;
 532               break;
 533             case OMP_LIST_MIN:
 534               reduction_code = MIN_EXPR;
 535               break;
 536             case OMP_LIST_IAND:
 537               reduction_code = BIT_AND_EXPR;
 538               break;
 539             case OMP_LIST_IOR:
 540               reduction_code = BIT_IOR_EXPR;
 541               break;
 542             case OMP_LIST_IEOR:
 543               reduction_code = BIT_XOR_EXPR;
 544               break;
 545             default:
 546               gcc_unreachable ();
 547             }
 548           old_clauses = omp_clauses;
 549           omp_clauses
 550             = gfc_trans_omp_reduction_list (n, omp_clauses, reduction_code,
 551                                             where);
 552           continue;
 553         }
 554       switch (list)
 555         {
 556         case OMP_LIST_PRIVATE:
 557           clause_code = OMP_CLAUSE_PRIVATE;
 558           goto add_clause;
 559         case OMP_LIST_SHARED:
 560           clause_code = OMP_CLAUSE_SHARED;
 561           goto add_clause;
 562         case OMP_LIST_FIRSTPRIVATE:
 563           clause_code = OMP_CLAUSE_FIRSTPRIVATE;
 564           goto add_clause;
 565         case OMP_LIST_LASTPRIVATE:
 566           clause_code = OMP_CLAUSE_LASTPRIVATE;
 567           goto add_clause;
 568         case OMP_LIST_COPYIN:
 569           clause_code = OMP_CLAUSE_COPYIN;
 570           goto add_clause;
 571         case OMP_LIST_COPYPRIVATE:
 572           clause_code = OMP_CLAUSE_COPYPRIVATE;
 573           /* FALLTHROUGH */
 574         add_clause:
 575           omp_clauses
 576             = gfc_trans_omp_variable_list (clause_code, n, omp_clauses);
 577           break;
 578         default:
 579           break;
 580         }
 581     }
 582
 583   if (clauses->if_expr)
 584     {
 585       tree if_var;
 586
 587       gfc_init_se (&se, NULL);
 588       gfc_conv_expr (&se, clauses->if_expr);
 589       gfc_add_block_to_block (block, &se.pre);
 590       if_var = gfc_evaluate_now (se.expr, block);
 591       gfc_add_block_to_block (block, &se.post);
 592
 593       c = build_omp_clause (OMP_CLAUSE_IF);
 594       OMP_CLAUSE_IF_EXPR (c) = if_var;
 595       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 596     }
 597
 598   if (clauses->num_threads)
 599     {
 600       tree num_threads;
 601
 602       gfc_init_se (&se, NULL);
 603       gfc_conv_expr (&se, clauses->num_threads);
 604       gfc_add_block_to_block (block, &se.pre);
 605       num_threads = gfc_evaluate_now (se.expr, block);
 606       gfc_add_block_to_block (block, &se.post);
 607
 608       c = build_omp_clause (OMP_CLAUSE_NUM_THREADS);
 609       OMP_CLAUSE_NUM_THREADS_EXPR (c) = num_threads;
 610       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 611     }
 612
 613   chunk_size = NULL_TREE;
 614   if (clauses->chunk_size)
 615     {
 616       gfc_init_se (&se, NULL);
 617       gfc_conv_expr (&se, clauses->chunk_size);
 618       gfc_add_block_to_block (block, &se.pre);
 619       chunk_size = gfc_evaluate_now (se.expr, block);
 620       gfc_add_block_to_block (block, &se.post);
 621     }
 622
 623   if (clauses->sched_kind != OMP_SCHED_NONE)
 624     {
 625       c = build_omp_clause (OMP_CLAUSE_SCHEDULE);
 626       OMP_CLAUSE_SCHEDULE_CHUNK_EXPR (c) = chunk_size;
 627       switch (clauses->sched_kind)
 628         {
 629         case OMP_SCHED_STATIC:
 630           OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_STATIC;
 631           break;
 632         case OMP_SCHED_DYNAMIC:
 633           OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_DYNAMIC;
 634           break;
 635         case OMP_SCHED_GUIDED:
 636           OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_GUIDED;
 637           break;
 638         case OMP_SCHED_RUNTIME:
 639           OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_RUNTIME;
 640           break;
 641         default:
 642           gcc_unreachable ();
 643         }
 644       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 645     }
 646
 647   if (clauses->default_sharing != OMP_DEFAULT_UNKNOWN)
 648     {
 649       c = build_omp_clause (OMP_CLAUSE_DEFAULT);
 650       switch (clauses->default_sharing)
 651         {
 652         case OMP_DEFAULT_NONE:
 653           OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_NONE;
 654           break;
 655         case OMP_DEFAULT_SHARED:
 656           OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_SHARED;
 657           break;
 658         case OMP_DEFAULT_PRIVATE:
 659           OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_PRIVATE;
 660           break;
 661         default:
 662           gcc_unreachable ();
 663         }
 664       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 665     }
 666
 667   if (clauses->nowait)
 668     {
 669       c = build_omp_clause (OMP_CLAUSE_NOWAIT);
 670       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 671     }
 672
 673   if (clauses->ordered)
 674     {
 675       c = build_omp_clause (OMP_CLAUSE_ORDERED);
 676       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 677     }
 678
 679   return omp_clauses;
 680 }
 681
 682 /* Like gfc_trans_code, but force creation of a BIND_EXPR around it.  */
 683
 684 static tree
 685 gfc_trans_omp_code (gfc_code *code, bool force_empty)
 686 {
 687   tree stmt;
 688
 689   pushlevel (0);
 690   stmt = gfc_trans_code (code);
 691   if (TREE_CODE (stmt) != BIND_EXPR)
 692     {
 693       if (!IS_EMPTY_STMT (stmt) || force_empty)
 694         {
 695           tree block = poplevel (1, 0, 0);
 696           stmt = build3_v (BIND_EXPR, NULL, stmt, block);
 697         }
 698       else
 699         poplevel (0, 0, 0);
 700     }
 701   else
 702     poplevel (0, 0, 0);
 703   return stmt;
 704 }
 705
 706
 707 static tree gfc_trans_omp_sections (gfc_code *, gfc_omp_clauses *);
 708 static tree gfc_trans_omp_workshare (gfc_code *, gfc_omp_clauses *);
 709
 710 static tree
 711 gfc_trans_omp_atomic (gfc_code *code)
 712 {
 713   gfc_se lse;
 714   gfc_se rse;
 715   gfc_expr *expr2, *e;
 716   gfc_symbol *var;
 717   stmtblock_t block;
 718   tree lhsaddr, type, rhs, x;
 719   enum tree_code op = ERROR_MARK;
 720   bool var_on_left = false;
 721
 722   code = code->block->next;
 723   gcc_assert (code->op == EXEC_ASSIGN);
 724   gcc_assert (code->next == NULL);
 725   var = code->expr->symtree->n.sym;
 726
 727   gfc_init_se (&lse, NULL);
 728   gfc_init_se (&rse, NULL);
 729   gfc_start_block (&block);
 730
 731   gfc_conv_expr (&lse, code->expr);
 732   gfc_add_block_to_block (&block, &lse.pre);
 733   type = TREE_TYPE (lse.expr);
 734   lhsaddr = gfc_build_addr_expr (NULL, lse.expr);
 735
 736   expr2 = code->expr2;
 737   if (expr2->expr_type == EXPR_FUNCTION
 738       && expr2->value.function.isym->id == GFC_ISYM_CONVERSION)
 739     expr2 = expr2->value.function.actual->expr;
 740
 741   if (expr2->expr_type == EXPR_OP)
 742     {
 743       gfc_expr *e;
 744       switch (expr2->value.op.operator)
 745         {
 746         case INTRINSIC_PLUS:
 747           op = PLUS_EXPR;
 748           break;
 749         case INTRINSIC_TIMES:
 750           op = MULT_EXPR;
 751           break;
 752         case INTRINSIC_MINUS:
 753           op = MINUS_EXPR;
 754           break;
 755         case INTRINSIC_DIVIDE:
 756           if (expr2->ts.type == BT_INTEGER)
 757             op = TRUNC_DIV_EXPR;
 758           else
 759             op = RDIV_EXPR;
 760           break;
 761         case INTRINSIC_AND:
 762           op = TRUTH_ANDIF_EXPR;
 763           break;
 764         case INTRINSIC_OR:
 765           op = TRUTH_ORIF_EXPR;
 766           break;
 767         case INTRINSIC_EQV:
 768           op = EQ_EXPR;
 769           break;
 770         case INTRINSIC_NEQV:
 771           op = NE_EXPR;
 772           break;
 773         default:
 774           gcc_unreachable ();
 775         }
 776       e = expr2->value.op.op1;
 777       if (e->expr_type == EXPR_FUNCTION
 778           && e->value.function.isym->id == GFC_ISYM_CONVERSION)
 779         e = e->value.function.actual->expr;
 780       if (e->expr_type == EXPR_VARIABLE
 781           && e->symtree != NULL
 782           && e->symtree->n.sym == var)
 783         {
 784           expr2 = expr2->value.op.op2;
 785           var_on_left = true;
 786         }
 787       else
 788         {
 789           e = expr2->value.op.op2;
 790           if (e->expr_type == EXPR_FUNCTION
 791               && e->value.function.isym->id == GFC_ISYM_CONVERSION)
 792             e = e->value.function.actual->expr;
 793           gcc_assert (e->expr_type == EXPR_VARIABLE
 794                       && e->symtree != NULL
 795                       && e->symtree->n.sym == var);
 796           expr2 = expr2->value.op.op1;
 797           var_on_left = false;
 798         }
 799       gfc_conv_expr (&rse, expr2);
 800       gfc_add_block_to_block (&block, &rse.pre);
 801     }
 802   else
 803     {
 804       gcc_assert (expr2->expr_type == EXPR_FUNCTION);
 805       switch (expr2->value.function.isym->id)
 806         {
 807         case GFC_ISYM_MIN:
 808           op = MIN_EXPR;
 809           break;
 810         case GFC_ISYM_MAX:
 811           op = MAX_EXPR;
 812           break;
 813         case GFC_ISYM_IAND:
 814           op = BIT_AND_EXPR;
 815           break;
 816         case GFC_ISYM_IOR:
 817           op = BIT_IOR_EXPR;
 818           break;
 819         case GFC_ISYM_IEOR:
 820           op = BIT_XOR_EXPR;
 821           break;
 822         default:
 823           gcc_unreachable ();
 824         }
 825       e = expr2->value.function.actual->expr;
 826       gcc_assert (e->expr_type == EXPR_VARIABLE
 827                   && e->symtree != NULL
 828                   && e->symtree->n.sym == var);
 829
 830       gfc_conv_expr (&rse, expr2->value.function.actual->next->expr);
 831       gfc_add_block_to_block (&block, &rse.pre);
 832       if (expr2->value.function.actual->next->next != NULL)
 833         {
 834           tree accum = gfc_create_var (TREE_TYPE (rse.expr), NULL);
 835           gfc_actual_arglist *arg;
 836
 837           gfc_add_modify_stmt (&block, accum, rse.expr);
 838           for (arg = expr2->value.function.actual->next->next; arg;
 839                arg = arg->next)
 840             {
 841               gfc_init_block (&rse.pre);
 842               gfc_conv_expr (&rse, arg->expr);
 843               gfc_add_block_to_block (&block, &rse.pre);
 844               x = fold_build2 (op, TREE_TYPE (accum), accum, rse.expr);
 845               gfc_add_modify_stmt (&block, accum, x);
 846             }
 847
 848           rse.expr = accum;
 849         }
 850
 851       expr2 = expr2->value.function.actual->next->expr;
 852     }
 853
 854   lhsaddr = save_expr (lhsaddr);
 855   rhs = gfc_evaluate_now (rse.expr, &block);
 856   x = convert (TREE_TYPE (rhs), build_fold_indirect_ref (lhsaddr));
 857
 858   if (var_on_left)
 859     x = fold_build2 (op, TREE_TYPE (rhs), x, rhs);
 860   else
 861     x = fold_build2 (op, TREE_TYPE (rhs), rhs, x);
 862
 863   if (TREE_CODE (TREE_TYPE (rhs)) == COMPLEX_TYPE
 864       && TREE_CODE (type) != COMPLEX_TYPE)
 865     x = build1 (REALPART_EXPR, TREE_TYPE (TREE_TYPE (rhs)), x);
 866
 867   x = build2_v (OMP_ATOMIC, lhsaddr, convert (type, x));
 868   gfc_add_expr_to_block (&block, x);
 869
 870   gfc_add_block_to_block (&block, &lse.pre);
 871   gfc_add_block_to_block (&block, &rse.pre);
 872
 873   return gfc_finish_block (&block);
 874 }
 875
 876 static tree
 877 gfc_trans_omp_barrier (void)
 878 {
 879   tree decl = built_in_decls [BUILT_IN_GOMP_BARRIER];
 880   return build_call_expr (decl, 0);
 881 }
 882
 883 static tree
 884 gfc_trans_omp_critical (gfc_code *code)
 885 {
 886   tree name = NULL_TREE, stmt;
 887   if (code->ext.omp_name != NULL)
 888     name = get_identifier (code->ext.omp_name);
 889   stmt = gfc_trans_code (code->block->next);
 890   return build2_v (OMP_CRITICAL, stmt, name);
 891 }
 892
 893 static tree
 894 gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
 895                   gfc_omp_clauses *do_clauses)
 896 {
 897   gfc_se se;
 898   tree dovar, stmt, from, to, step, type, init, cond, incr;
 899   tree count = NULL_TREE, cycle_label, tmp, omp_clauses;
 900   stmtblock_t block;
 901   stmtblock_t body;
 902   int simple = 0;
 903   bool dovar_found = false;
 904   gfc_omp_clauses *clauses = code->ext.omp_clauses;
 905
 906   code = code->block->next;
 907   gcc_assert (code->op == EXEC_DO);
 908
 909   if (pblock == NULL)
 910     {
 911       gfc_start_block (&block);
 912       pblock = &block;
 913     }
 914
 915   omp_clauses = gfc_trans_omp_clauses (pblock, do_clauses, code->loc);
 916   if (clauses)
 917     {
 918       gfc_namelist *n;
 919       for (n = clauses->lists[OMP_LIST_LASTPRIVATE]; n != NULL; n = n->next)
 920         if (code->ext.iterator->var->symtree->n.sym == n->sym)
 921           break;
 922       if (n == NULL)
 923         for (n = clauses->lists[OMP_LIST_PRIVATE]; n != NULL; n = n->next)
 924           if (code->ext.iterator->var->symtree->n.sym == n->sym)
 925             break;
 926       if (n != NULL)
 927         dovar_found = true;
 928     }
 929
 930   /* Evaluate all the expressions in the iterator.  */
 931   gfc_init_se (&se, NULL);
 932   gfc_conv_expr_lhs (&se, code->ext.iterator->var);
 933   gfc_add_block_to_block (pblock, &se.pre);
 934   dovar = se.expr;
 935   type = TREE_TYPE (dovar);
 936   gcc_assert (TREE_CODE (type) == INTEGER_TYPE);
 937
 938   gfc_init_se (&se, NULL);
 939   gfc_conv_expr_val (&se, code->ext.iterator->start);
 940   gfc_add_block_to_block (pblock, &se.pre);
 941   from = gfc_evaluate_now (se.expr, pblock);
 942
 943   gfc_init_se (&se, NULL);
 944   gfc_conv_expr_val (&se, code->ext.iterator->end);
 945   gfc_add_block_to_block (pblock, &se.pre);
 946   to = gfc_evaluate_now (se.expr, pblock);
 947
 948   gfc_init_se (&se, NULL);
 949   gfc_conv_expr_val (&se, code->ext.iterator->step);
 950   gfc_add_block_to_block (pblock, &se.pre);
 951   step = gfc_evaluate_now (se.expr, pblock);
 952
 953   /* Special case simple loops.  */
 954   if (integer_onep (step))
 955     simple = 1;
 956   else if (tree_int_cst_equal (step, integer_minus_one_node))
 957     simple = -1;
 958
 959   /* Loop body.  */
 960   if (simple)
 961     {
 962       init = build2_v (GIMPLE_MODIFY_STMT, dovar, from);
 963       cond = build2 (simple > 0 ? LE_EXPR : GE_EXPR, boolean_type_node,
 964                      dovar, to);
 965       incr = fold_build2 (PLUS_EXPR, type, dovar, step);
 966       incr = fold_build2 (GIMPLE_MODIFY_STMT, type, dovar, incr);
 967       if (pblock != &block)
 968         {
 969           pushlevel (0);
 970           gfc_start_block (&block);
 971         }
 972       gfc_start_block (&body);
 973     }
 974   else
 975     {
 976       /* STEP is not 1 or -1.  Use:
 977          for (count = 0; count < (to + step - from) / step; count++)
 978            {
 979              dovar = from + count * step;
 980              body;
 981            cycle_label:;
 982            }  */
 983       tmp = fold_build2 (MINUS_EXPR, type, step, from);
 984       tmp = fold_build2 (PLUS_EXPR, type, to, tmp);
 985       tmp = fold_build2 (TRUNC_DIV_EXPR, type, tmp, step);
 986       tmp = gfc_evaluate_now (tmp, pblock);
 987       count = gfc_create_var (type, "count");
 988       init = build2_v (GIMPLE_MODIFY_STMT, count, build_int_cst (type, 0));
 989       cond = build2 (LT_EXPR, boolean_type_node, count, tmp);
 990       incr = fold_build2 (PLUS_EXPR, type, count, build_int_cst (type, 1));
 991       incr = fold_build2 (GIMPLE_MODIFY_STMT, type, count, incr);
 992
 993       if (pblock != &block)
 994         {
 995           pushlevel (0);
 996           gfc_start_block (&block);
 997         }
 998       gfc_start_block (&body);
 999
1000       /* Initialize DOVAR.  */
1001       tmp = fold_build2 (MULT_EXPR, type, count, step);
1002       tmp = build2 (PLUS_EXPR, type, from, tmp);
1003       gfc_add_modify_stmt (&body, dovar, tmp);
1004     }
1005
1006   if (!dovar_found)
1007     {
1008       tmp = build_omp_clause (OMP_CLAUSE_PRIVATE);
1009       OMP_CLAUSE_DECL (tmp) = dovar;
1010       omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
1011     }
1012   if (!simple)
1013     {
1014       tmp = build_omp_clause (OMP_CLAUSE_PRIVATE);
1015       OMP_CLAUSE_DECL (tmp) = count;
1016       omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
1017     }
1018
1019   /* Cycle statement is implemented with a goto.  Exit statement must not be
1020      present for this loop.  */
1021   cycle_label = gfc_build_label_decl (NULL_TREE);
1022
1023   /* Put these labels where they can be found later. We put the
1024      labels in a TREE_LIST node (because TREE_CHAIN is already
1025      used). cycle_label goes in TREE_PURPOSE (backend_decl), exit
1026      label in TREE_VALUE (backend_decl).  */
1027
1028   code->block->backend_decl = tree_cons (cycle_label, NULL, NULL);
1029
1030   /* Main loop body.  */
1031   tmp = gfc_trans_omp_code (code->block->next, true);
1032   gfc_add_expr_to_block (&body, tmp);
1033
1034   /* Label for cycle statements (if needed).  */
1035   if (TREE_USED (cycle_label))
1036     {
1037       tmp = build1_v (LABEL_EXPR, cycle_label);
1038       gfc_add_expr_to_block (&body, tmp);
1039     }
1040
1041   /* End of loop body.  */
1042   stmt = make_node (OMP_FOR);
1043
1044   TREE_TYPE (stmt) = void_type_node;
1045   OMP_FOR_BODY (stmt) = gfc_finish_block (&body);
1046   OMP_FOR_CLAUSES (stmt) = omp_clauses;
1047   OMP_FOR_INIT (stmt) = init;
1048   OMP_FOR_COND (stmt) = cond;
1049   OMP_FOR_INCR (stmt) = incr;
1050   gfc_add_expr_to_block (&block, stmt);
1051
1052   return gfc_finish_block (&block);
1053 }
1054
1055 static tree
1056 gfc_trans_omp_flush (void)
1057 {
1058   tree decl = built_in_decls [BUILT_IN_SYNCHRONIZE];
1059   return build_call_expr (decl, 0);
1060 }
1061
1062 static tree
1063 gfc_trans_omp_master (gfc_code *code)
1064 {
1065   tree stmt = gfc_trans_code (code->block->next);
1066   if (IS_EMPTY_STMT (stmt))
1067     return stmt;
1068   return build1_v (OMP_MASTER, stmt);
1069 }
1070
1071 static tree
1072 gfc_trans_omp_ordered (gfc_code *code)
1073 {
1074   return build1_v (OMP_ORDERED, gfc_trans_code (code->block->next));
1075 }
1076
1077 static tree
1078 gfc_trans_omp_parallel (gfc_code *code)
1079 {
1080   stmtblock_t block;
1081   tree stmt, omp_clauses;
1082
1083   gfc_start_block (&block);
1084   omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
1085                                        code->loc);
1086   stmt = gfc_trans_omp_code (code->block->next, true);
1087   stmt = build4_v (OMP_PARALLEL, stmt, omp_clauses, NULL, NULL);
1088   gfc_add_expr_to_block (&block, stmt);
1089   return gfc_finish_block (&block);
1090 }
1091
1092 static tree
1093 gfc_trans_omp_parallel_do (gfc_code *code)
1094 {
1095   stmtblock_t block, *pblock = NULL;
1096   gfc_omp_clauses parallel_clauses, do_clauses;
1097   tree stmt, omp_clauses = NULL_TREE;
1098
1099   gfc_start_block (&block);
1100
1101   memset (&do_clauses, 0, sizeof (do_clauses));
1102   if (code->ext.omp_clauses != NULL)
1103     {
1104       memcpy (&parallel_clauses, code->ext.omp_clauses,
1105               sizeof (parallel_clauses));
1106       do_clauses.sched_kind = parallel_clauses.sched_kind;
1107       do_clauses.chunk_size = parallel_clauses.chunk_size;
1108       do_clauses.ordered = parallel_clauses.ordered;
1109       parallel_clauses.sched_kind = OMP_SCHED_NONE;
1110       parallel_clauses.chunk_size = NULL;
1111       parallel_clauses.ordered = false;
1112       omp_clauses = gfc_trans_omp_clauses (&block, &parallel_clauses,
1113                                            code->loc);
1114     }
1115   do_clauses.nowait = true;
1116   if (!do_clauses.ordered && do_clauses.sched_kind != OMP_SCHED_STATIC)
1117     pblock = &block;
1118   else
1119     pushlevel (0);
1120   stmt = gfc_trans_omp_do (code, pblock, &do_clauses);
1121   if (TREE_CODE (stmt) != BIND_EXPR)
1122     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
1123   else
1124     poplevel (0, 0, 0);
1125   stmt = build4_v (OMP_PARALLEL, stmt, omp_clauses, NULL, NULL);
1126   OMP_PARALLEL_COMBINED (stmt) = 1;
1127   gfc_add_expr_to_block (&block, stmt);
1128   return gfc_finish_block (&block);
1129 }
1130
1131 static tree
1132 gfc_trans_omp_parallel_sections (gfc_code *code)
1133 {
1134   stmtblock_t block;
1135   gfc_omp_clauses section_clauses;
1136   tree stmt, omp_clauses;
1137
1138   memset (&section_clauses, 0, sizeof (section_clauses));
1139   section_clauses.nowait = true;
1140
1141   gfc_start_block (&block);
1142   omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
1143                                        code->loc);
1144   pushlevel (0);
1145   stmt = gfc_trans_omp_sections (code, &section_clauses);
1146   if (TREE_CODE (stmt) != BIND_EXPR)
1147     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
1148   else
1149     poplevel (0, 0, 0);
1150   stmt = build4_v (OMP_PARALLEL, stmt, omp_clauses, NULL, NULL);
1151   OMP_PARALLEL_COMBINED (stmt) = 1;
1152   gfc_add_expr_to_block (&block, stmt);
1153   return gfc_finish_block (&block);
1154 }
1155
1156 static tree
1157 gfc_trans_omp_parallel_workshare (gfc_code *code)
1158 {
1159   stmtblock_t block;
1160   gfc_omp_clauses workshare_clauses;
1161   tree stmt, omp_clauses;
1162
1163   memset (&workshare_clauses, 0, sizeof (workshare_clauses));
1164   workshare_clauses.nowait = true;
1165
1166   gfc_start_block (&block);
1167   omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
1168                                        code->loc);
1169   pushlevel (0);
1170   stmt = gfc_trans_omp_workshare (code, &workshare_clauses);
1171   if (TREE_CODE (stmt) != BIND_EXPR)
1172     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
1173   else
1174     poplevel (0, 0, 0);
1175   stmt = build4_v (OMP_PARALLEL, stmt, omp_clauses, NULL, NULL);
1176   OMP_PARALLEL_COMBINED (stmt) = 1;
1177   gfc_add_expr_to_block (&block, stmt);
1178   return gfc_finish_block (&block);
1179 }
1180
1181 static tree
1182 gfc_trans_omp_sections (gfc_code *code, gfc_omp_clauses *clauses)
1183 {
1184   stmtblock_t block, body;
1185   tree omp_clauses, stmt;
1186   bool has_lastprivate = clauses->lists[OMP_LIST_LASTPRIVATE] != NULL;
1187
1188   gfc_start_block (&block);
1189
1190   omp_clauses = gfc_trans_omp_clauses (&block, clauses, code->loc);
1191
1192   gfc_init_block (&body);
1193   for (code = code->block; code; code = code->block)
1194     {
1195       /* Last section is special because of lastprivate, so even if it
1196          is empty, chain it in.  */
1197       stmt = gfc_trans_omp_code (code->next,
1198                                  has_lastprivate && code->block == NULL);
1199       if (! IS_EMPTY_STMT (stmt))
1200         {
1201           stmt = build1_v (OMP_SECTION, stmt);
1202           gfc_add_expr_to_block (&body, stmt);
1203         }
1204     }
1205   stmt = gfc_finish_block (&body);
1206
1207   stmt = build3_v (OMP_SECTIONS, stmt, omp_clauses, NULL_TREE);
1208   gfc_add_expr_to_block (&block, stmt);
1209
1210   return gfc_finish_block (&block);
1211 }
1212
1213 static tree
1214 gfc_trans_omp_single (gfc_code *code, gfc_omp_clauses *clauses)
1215 {
1216   tree omp_clauses = gfc_trans_omp_clauses (NULL, clauses, code->loc);
1217   tree stmt = gfc_trans_omp_code (code->block->next, true);
1218   stmt = build2_v (OMP_SINGLE, stmt, omp_clauses);
1219   return stmt;
1220 }
1221
1222 static tree
1223 gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses)
1224 {
1225   /* XXX */
1226   return gfc_trans_omp_single (code, clauses);
1227 }
1228
1229 tree
1230 gfc_trans_omp_directive (gfc_code *code)
1231 {
1232   switch (code->op)
1233     {
1234     case EXEC_OMP_ATOMIC:
1235       return gfc_trans_omp_atomic (code);
1236     case EXEC_OMP_BARRIER:
1237       return gfc_trans_omp_barrier ();
1238     case EXEC_OMP_CRITICAL:
1239       return gfc_trans_omp_critical (code);
1240     case EXEC_OMP_DO:
1241       return gfc_trans_omp_do (code, NULL, code->ext.omp_clauses);
1242     case EXEC_OMP_FLUSH:
1243       return gfc_trans_omp_flush ();
1244     case EXEC_OMP_MASTER:
1245       return gfc_trans_omp_master (code);
1246     case EXEC_OMP_ORDERED:
1247       return gfc_trans_omp_ordered (code);
1248     case EXEC_OMP_PARALLEL:
1249       return gfc_trans_omp_parallel (code);
1250     case EXEC_OMP_PARALLEL_DO:
1251       return gfc_trans_omp_parallel_do (code);
1252     case EXEC_OMP_PARALLEL_SECTIONS:
1253       return gfc_trans_omp_parallel_sections (code);
1254     case EXEC_OMP_PARALLEL_WORKSHARE:
1255       return gfc_trans_omp_parallel_workshare (code);
1256     case EXEC_OMP_SECTIONS:
1257       return gfc_trans_omp_sections (code, code->ext.omp_clauses);
1258     case EXEC_OMP_SINGLE:
1259       return gfc_trans_omp_single (code, code->ext.omp_clauses);
1260     case EXEC_OMP_WORKSHARE:
1261       return gfc_trans_omp_workshare (code, code->ext.omp_clauses);
1262     default:
1263       gcc_unreachable ();
1264     }
1265 }