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