gcc/fortran/trans-openmp.c

   1 /* OpenMP directive translation -- generate GCC trees from gfc_code.
   2    Copyright (C) 2005, 2006 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 (&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   backend_decl = omp_reduction_init (c, gfc_sym_type (&init_val_sym));
 304   init_val_sym.backend_decl = backend_decl;
 305
 306   /* Create a fake symbol for the outer array reference.  */
 307   outer_sym = *sym;
 308   outer_sym.as = gfc_copy_array_spec (sym->as);
 309   outer_sym.attr.dummy = 0;
 310   outer_sym.attr.result = 0;
 311   outer_sym.backend_decl = create_tmp_var_raw (TREE_TYPE (decl), NULL);
 312
 313   /* Create fake symtrees for it.  */
 314   symtree1 = gfc_new_symtree (&root1, sym->name);
 315   symtree1->n.sym = sym;
 316   gcc_assert (symtree1 == root1);
 317
 318   symtree2 = gfc_new_symtree (&root2, sym->name);
 319   symtree2->n.sym = &init_val_sym;
 320   gcc_assert (symtree2 == root2);
 321
 322   symtree3 = gfc_new_symtree (&root3, sym->name);
 323   symtree3->n.sym = &outer_sym;
 324   gcc_assert (symtree3 == root3);
 325
 326   /* Create expressions.  */
 327   e1 = gfc_get_expr ();
 328   e1->expr_type = EXPR_VARIABLE;
 329   e1->where = where;
 330   e1->symtree = symtree1;
 331   e1->ts = sym->ts;
 332   e1->ref = ref = gfc_get_ref ();
 333   ref->u.ar.where = where;
 334   ref->u.ar.as = sym->as;
 335   ref->u.ar.type = AR_FULL;
 336   ref->u.ar.dimen = 0;
 337   t = gfc_resolve_expr (e1);
 338   gcc_assert (t == SUCCESS);
 339
 340   e2 = gfc_get_expr ();
 341   e2->expr_type = EXPR_VARIABLE;
 342   e2->where = where;
 343   e2->symtree = symtree2;
 344   e2->ts = sym->ts;
 345   t = gfc_resolve_expr (e2);
 346   gcc_assert (t == SUCCESS);
 347
 348   e3 = gfc_copy_expr (e1);
 349   e3->symtree = symtree3;
 350   t = gfc_resolve_expr (e3);
 351   gcc_assert (t == SUCCESS);
 352
 353   iname = NULL;
 354   switch (OMP_CLAUSE_REDUCTION_CODE (c))
 355     {
 356     case PLUS_EXPR:
 357     case MINUS_EXPR:
 358       e4 = gfc_add (e3, e1);
 359       break;
 360     case MULT_EXPR:
 361       e4 = gfc_multiply (e3, e1);
 362       break;
 363     case TRUTH_ANDIF_EXPR:
 364       e4 = gfc_and (e3, e1);
 365       break;
 366     case TRUTH_ORIF_EXPR:
 367       e4 = gfc_or (e3, e1);
 368       break;
 369     case EQ_EXPR:
 370       e4 = gfc_eqv (e3, e1);
 371       break;
 372     case NE_EXPR:
 373       e4 = gfc_neqv (e3, e1);
 374       break;
 375     case MIN_EXPR:
 376       iname = "min";
 377       break;
 378     case MAX_EXPR:
 379       iname = "max";
 380       break;
 381     case BIT_AND_EXPR:
 382       iname = "iand";
 383       break;
 384     case BIT_IOR_EXPR:
 385       iname = "ior";
 386       break;
 387     case BIT_XOR_EXPR:
 388       iname = "ieor";
 389       break;
 390     default:
 391       gcc_unreachable ();
 392     }
 393   if (iname != NULL)
 394     {
 395       memset (&intrinsic_sym, 0, sizeof (intrinsic_sym));
 396       intrinsic_sym.ns = sym->ns;
 397       intrinsic_sym.name = iname;
 398       intrinsic_sym.ts = sym->ts;
 399       intrinsic_sym.attr.referenced = 1;
 400       intrinsic_sym.attr.intrinsic = 1;
 401       intrinsic_sym.attr.function = 1;
 402       intrinsic_sym.result = &intrinsic_sym;
 403       intrinsic_sym.declared_at = where;
 404
 405       symtree4 = gfc_new_symtree (&root4, iname);
 406       symtree4->n.sym = &intrinsic_sym;
 407       gcc_assert (symtree4 == root4);
 408
 409       e4 = gfc_get_expr ();
 410       e4->expr_type = EXPR_FUNCTION;
 411       e4->where = where;
 412       e4->symtree = symtree4;
 413       e4->value.function.isym = gfc_find_function (iname);
 414       e4->value.function.actual = gfc_get_actual_arglist ();
 415       e4->value.function.actual->expr = e3;
 416       e4->value.function.actual->next = gfc_get_actual_arglist ();
 417       e4->value.function.actual->next->expr = e1;
 418     }
 419   /* e1 and e3 have been stored as arguments of e4, avoid sharing.  */
 420   e1 = gfc_copy_expr (e1);
 421   e3 = gfc_copy_expr (e3);
 422   t = gfc_resolve_expr (e4);
 423   gcc_assert (t == SUCCESS);
 424
 425   /* Create the init statement list.  */
 426   pushlevel (0);
 427   stmt = gfc_trans_assignment (e1, e2);
 428   if (TREE_CODE (stmt) != BIND_EXPR)
 429     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
 430   else
 431     poplevel (0, 0, 0);
 432   OMP_CLAUSE_REDUCTION_INIT (c) = stmt;
 433
 434   /* Create the merge statement list.  */
 435   pushlevel (0);
 436   stmt = gfc_trans_assignment (e3, e4);
 437   if (TREE_CODE (stmt) != BIND_EXPR)
 438     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
 439   else
 440     poplevel (0, 0, 0);
 441   OMP_CLAUSE_REDUCTION_MERGE (c) = stmt;
 442
 443   /* And stick the placeholder VAR_DECL into the clause as well.  */
 444   OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) = outer_sym.backend_decl;
 445
 446   gfc_current_locus = old_loc;
 447
 448   gfc_free_expr (e1);
 449   gfc_free_expr (e2);
 450   gfc_free_expr (e3);
 451   gfc_free_expr (e4);
 452   gfc_free (symtree1);
 453   gfc_free (symtree2);
 454   gfc_free (symtree3);
 455   if (symtree4)
 456     gfc_free (symtree4);
 457   gfc_free_array_spec (outer_sym.as);
 458 }
 459
 460 static tree
 461 gfc_trans_omp_reduction_list (gfc_namelist *namelist, tree list,
 462                               enum tree_code reduction_code, locus where)
 463 {
 464   for (; namelist != NULL; namelist = namelist->next)
 465     if (namelist->sym->attr.referenced)
 466       {
 467         tree t = gfc_trans_omp_variable (namelist->sym);
 468         if (t != error_mark_node)
 469           {
 470             tree node = build_omp_clause (OMP_CLAUSE_REDUCTION);
 471             OMP_CLAUSE_DECL (node) = t;
 472             OMP_CLAUSE_REDUCTION_CODE (node) = reduction_code;
 473             if (namelist->sym->attr.dimension)
 474               gfc_trans_omp_array_reduction (node, namelist->sym, where);
 475             list = gfc_trans_add_clause (node, list);
 476           }
 477       }
 478   return list;
 479 }
 480
 481 static tree
 482 gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 483                        locus where)
 484 {
 485   tree omp_clauses = NULL_TREE, chunk_size, c, old_clauses;
 486   int list;
 487   enum omp_clause_code clause_code;
 488   gfc_se se;
 489
 490   if (clauses == NULL)
 491     return NULL_TREE;
 492
 493   for (list = 0; list < OMP_LIST_NUM; list++)
 494     {
 495       gfc_namelist *n = clauses->lists[list];
 496
 497       if (n == NULL)
 498         continue;
 499       if (list >= OMP_LIST_REDUCTION_FIRST
 500           && list <= OMP_LIST_REDUCTION_LAST)
 501         {
 502           enum tree_code reduction_code;
 503           switch (list)
 504             {
 505             case OMP_LIST_PLUS:
 506               reduction_code = PLUS_EXPR;
 507               break;
 508             case OMP_LIST_MULT:
 509               reduction_code = MULT_EXPR;
 510               break;
 511             case OMP_LIST_SUB:
 512               reduction_code = MINUS_EXPR;
 513               break;
 514             case OMP_LIST_AND:
 515               reduction_code = TRUTH_ANDIF_EXPR;
 516               break;
 517             case OMP_LIST_OR:
 518               reduction_code = TRUTH_ORIF_EXPR;
 519               break;
 520             case OMP_LIST_EQV:
 521               reduction_code = EQ_EXPR;
 522               break;
 523             case OMP_LIST_NEQV:
 524               reduction_code = NE_EXPR;
 525               break;
 526             case OMP_LIST_MAX:
 527               reduction_code = MAX_EXPR;
 528               break;
 529             case OMP_LIST_MIN:
 530               reduction_code = MIN_EXPR;
 531               break;
 532             case OMP_LIST_IAND:
 533               reduction_code = BIT_AND_EXPR;
 534               break;
 535             case OMP_LIST_IOR:
 536               reduction_code = BIT_IOR_EXPR;
 537               break;
 538             case OMP_LIST_IEOR:
 539               reduction_code = BIT_XOR_EXPR;
 540               break;
 541             default:
 542               gcc_unreachable ();
 543             }
 544           old_clauses = omp_clauses;
 545           omp_clauses
 546             = gfc_trans_omp_reduction_list (n, omp_clauses, reduction_code,
 547                                             where);
 548           continue;
 549         }
 550       switch (list)
 551         {
 552         case OMP_LIST_PRIVATE:
 553           clause_code = OMP_CLAUSE_PRIVATE;
 554           goto add_clause;
 555         case OMP_LIST_SHARED:
 556           clause_code = OMP_CLAUSE_SHARED;
 557           goto add_clause;
 558         case OMP_LIST_FIRSTPRIVATE:
 559           clause_code = OMP_CLAUSE_FIRSTPRIVATE;
 560           goto add_clause;
 561         case OMP_LIST_LASTPRIVATE:
 562           clause_code = OMP_CLAUSE_LASTPRIVATE;
 563           goto add_clause;
 564         case OMP_LIST_COPYIN:
 565           clause_code = OMP_CLAUSE_COPYIN;
 566           goto add_clause;
 567         case OMP_LIST_COPYPRIVATE:
 568           clause_code = OMP_CLAUSE_COPYPRIVATE;
 569           /* FALLTHROUGH */
 570         add_clause:
 571           omp_clauses
 572             = gfc_trans_omp_variable_list (clause_code, n, omp_clauses);
 573           break;
 574         default:
 575           break;
 576         }
 577     }
 578
 579   if (clauses->if_expr)
 580     {
 581       tree if_var;
 582
 583       gfc_init_se (&se, NULL);
 584       gfc_conv_expr (&se, clauses->if_expr);
 585       gfc_add_block_to_block (block, &se.pre);
 586       if_var = gfc_evaluate_now (se.expr, block);
 587       gfc_add_block_to_block (block, &se.post);
 588
 589       c = build_omp_clause (OMP_CLAUSE_IF);
 590       OMP_CLAUSE_IF_EXPR (c) = if_var;
 591       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 592     }
 593
 594   if (clauses->num_threads)
 595     {
 596       tree num_threads;
 597
 598       gfc_init_se (&se, NULL);
 599       gfc_conv_expr (&se, clauses->num_threads);
 600       gfc_add_block_to_block (block, &se.pre);
 601       num_threads = gfc_evaluate_now (se.expr, block);
 602       gfc_add_block_to_block (block, &se.post);
 603
 604       c = build_omp_clause (OMP_CLAUSE_NUM_THREADS);
 605       OMP_CLAUSE_NUM_THREADS_EXPR (c) = num_threads;
 606       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 607     }
 608
 609   chunk_size = NULL_TREE;
 610   if (clauses->chunk_size)
 611     {
 612       gfc_init_se (&se, NULL);
 613       gfc_conv_expr (&se, clauses->chunk_size);
 614       gfc_add_block_to_block (block, &se.pre);
 615       chunk_size = gfc_evaluate_now (se.expr, block);
 616       gfc_add_block_to_block (block, &se.post);
 617     }
 618
 619   if (clauses->sched_kind != OMP_SCHED_NONE)
 620     {
 621       c = build_omp_clause (OMP_CLAUSE_SCHEDULE);
 622       OMP_CLAUSE_SCHEDULE_CHUNK_EXPR (c) = chunk_size;
 623       switch (clauses->sched_kind)
 624         {
 625         case OMP_SCHED_STATIC:
 626           OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_STATIC;
 627           break;
 628         case OMP_SCHED_DYNAMIC:
 629           OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_DYNAMIC;
 630           break;
 631         case OMP_SCHED_GUIDED:
 632           OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_GUIDED;
 633           break;
 634         case OMP_SCHED_RUNTIME:
 635           OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_RUNTIME;
 636           break;
 637         default:
 638           gcc_unreachable ();
 639         }
 640       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 641     }
 642
 643   if (clauses->default_sharing != OMP_DEFAULT_UNKNOWN)
 644     {
 645       c = build_omp_clause (OMP_CLAUSE_DEFAULT);
 646       switch (clauses->default_sharing)
 647         {
 648         case OMP_DEFAULT_NONE:
 649           OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_NONE;
 650           break;
 651         case OMP_DEFAULT_SHARED:
 652           OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_SHARED;
 653           break;
 654         case OMP_DEFAULT_PRIVATE:
 655           OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_PRIVATE;
 656           break;
 657         default:
 658           gcc_unreachable ();
 659         }
 660       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 661     }
 662
 663   if (clauses->nowait)
 664     {
 665       c = build_omp_clause (OMP_CLAUSE_NOWAIT);
 666       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 667     }
 668
 669   if (clauses->ordered)
 670     {
 671       c = build_omp_clause (OMP_CLAUSE_ORDERED);
 672       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 673     }
 674
 675   return omp_clauses;
 676 }
 677
 678 /* Like gfc_trans_code, but force creation of a BIND_EXPR around it.  */
 679
 680 static tree
 681 gfc_trans_omp_code (gfc_code *code, bool force_empty)
 682 {
 683   tree stmt;
 684
 685   pushlevel (0);
 686   stmt = gfc_trans_code (code);
 687   if (TREE_CODE (stmt) != BIND_EXPR)
 688     {
 689       if (!IS_EMPTY_STMT (stmt) || force_empty)
 690         {
 691           tree block = poplevel (1, 0, 0);
 692           stmt = build3_v (BIND_EXPR, NULL, stmt, block);
 693         }
 694       else
 695         poplevel (0, 0, 0);
 696     }
 697   else
 698     poplevel (0, 0, 0);
 699   return stmt;
 700 }
 701
 702
 703 static tree gfc_trans_omp_sections (gfc_code *, gfc_omp_clauses *);
 704 static tree gfc_trans_omp_workshare (gfc_code *, gfc_omp_clauses *);
 705
 706 static tree
 707 gfc_trans_omp_atomic (gfc_code *code)
 708 {
 709   gfc_se lse;
 710   gfc_se rse;
 711   gfc_expr *expr2, *e;
 712   gfc_symbol *var;
 713   stmtblock_t block;
 714   tree lhsaddr, type, rhs, x;
 715   enum tree_code op = ERROR_MARK;
 716   bool var_on_left = false;
 717
 718   code = code->block->next;
 719   gcc_assert (code->op == EXEC_ASSIGN);
 720   gcc_assert (code->next == NULL);
 721   var = code->expr->symtree->n.sym;
 722
 723   gfc_init_se (&lse, NULL);
 724   gfc_init_se (&rse, NULL);
 725   gfc_start_block (&block);
 726
 727   gfc_conv_expr (&lse, code->expr);
 728   gfc_add_block_to_block (&block, &lse.pre);
 729   type = TREE_TYPE (lse.expr);
 730   lhsaddr = gfc_build_addr_expr (NULL, lse.expr);
 731
 732   expr2 = code->expr2;
 733   if (expr2->expr_type == EXPR_FUNCTION
 734       && expr2->value.function.isym->generic_id == GFC_ISYM_CONVERSION)
 735     expr2 = expr2->value.function.actual->expr;
 736
 737   if (expr2->expr_type == EXPR_OP)
 738     {
 739       gfc_expr *e;
 740       switch (expr2->value.op.operator)
 741         {
 742         case INTRINSIC_PLUS:
 743           op = PLUS_EXPR;
 744           break;
 745         case INTRINSIC_TIMES:
 746           op = MULT_EXPR;
 747           break;
 748         case INTRINSIC_MINUS:
 749           op = MINUS_EXPR;
 750           break;
 751         case INTRINSIC_DIVIDE:
 752           if (expr2->ts.type == BT_INTEGER)
 753             op = TRUNC_DIV_EXPR;
 754           else
 755             op = RDIV_EXPR;
 756           break;
 757         case INTRINSIC_AND:
 758           op = TRUTH_ANDIF_EXPR;
 759           break;
 760         case INTRINSIC_OR:
 761           op = TRUTH_ORIF_EXPR;
 762           break;
 763         case INTRINSIC_EQV:
 764           op = EQ_EXPR;
 765           break;
 766         case INTRINSIC_NEQV:
 767           op = NE_EXPR;
 768           break;
 769         default:
 770           gcc_unreachable ();
 771         }
 772       e = expr2->value.op.op1;
 773       if (e->expr_type == EXPR_FUNCTION
 774           && e->value.function.isym->generic_id == GFC_ISYM_CONVERSION)
 775         e = e->value.function.actual->expr;
 776       if (e->expr_type == EXPR_VARIABLE
 777           && e->symtree != NULL
 778           && e->symtree->n.sym == var)
 779         {
 780           expr2 = expr2->value.op.op2;
 781           var_on_left = true;
 782         }
 783       else
 784         {
 785           e = expr2->value.op.op2;
 786           if (e->expr_type == EXPR_FUNCTION
 787               && e->value.function.isym->generic_id == GFC_ISYM_CONVERSION)
 788             e = e->value.function.actual->expr;
 789           gcc_assert (e->expr_type == EXPR_VARIABLE
 790                       && e->symtree != NULL
 791                       && e->symtree->n.sym == var);
 792           expr2 = expr2->value.op.op1;
 793           var_on_left = false;
 794         }
 795       gfc_conv_expr (&rse, expr2);
 796       gfc_add_block_to_block (&block, &rse.pre);
 797     }
 798   else
 799     {
 800       gcc_assert (expr2->expr_type == EXPR_FUNCTION);
 801       switch (expr2->value.function.isym->generic_id)
 802         {
 803         case GFC_ISYM_MIN:
 804           op = MIN_EXPR;
 805           break;
 806         case GFC_ISYM_MAX:
 807           op = MAX_EXPR;
 808           break;
 809         case GFC_ISYM_IAND:
 810           op = BIT_AND_EXPR;
 811           break;
 812         case GFC_ISYM_IOR:
 813           op = BIT_IOR_EXPR;
 814           break;
 815         case GFC_ISYM_IEOR:
 816           op = BIT_XOR_EXPR;
 817           break;
 818         default:
 819           gcc_unreachable ();
 820         }
 821       e = expr2->value.function.actual->expr;
 822       gcc_assert (e->expr_type == EXPR_VARIABLE
 823                   && e->symtree != NULL
 824                   && e->symtree->n.sym == var);
 825
 826       gfc_conv_expr (&rse, expr2->value.function.actual->next->expr);
 827       gfc_add_block_to_block (&block, &rse.pre);
 828       if (expr2->value.function.actual->next->next != NULL)
 829         {
 830           tree accum = gfc_create_var (TREE_TYPE (rse.expr), NULL);
 831           gfc_actual_arglist *arg;
 832
 833           gfc_add_modify_expr (&block, accum, rse.expr);
 834           for (arg = expr2->value.function.actual->next->next; arg;
 835                arg = arg->next)
 836             {
 837               gfc_init_block (&rse.pre);
 838               gfc_conv_expr (&rse, arg->expr);
 839               gfc_add_block_to_block (&block, &rse.pre);
 840               x = fold_build2 (op, TREE_TYPE (accum), accum, rse.expr);
 841               gfc_add_modify_expr (&block, accum, x);
 842             }
 843
 844           rse.expr = accum;
 845         }
 846
 847       expr2 = expr2->value.function.actual->next->expr;
 848     }
 849
 850   lhsaddr = save_expr (lhsaddr);
 851   rhs = gfc_evaluate_now (rse.expr, &block);
 852   x = convert (TREE_TYPE (rhs), build_fold_indirect_ref (lhsaddr));
 853
 854   if (var_on_left)
 855     x = fold_build2 (op, TREE_TYPE (rhs), x, rhs);
 856   else
 857     x = fold_build2 (op, TREE_TYPE (rhs), rhs, x);
 858
 859   if (TREE_CODE (TREE_TYPE (rhs)) == COMPLEX_TYPE
 860       && TREE_CODE (type) != COMPLEX_TYPE)
 861     x = build1 (REALPART_EXPR, TREE_TYPE (TREE_TYPE (rhs)), x);
 862
 863   x = build2_v (OMP_ATOMIC, lhsaddr, convert (type, x));
 864   gfc_add_expr_to_block (&block, x);
 865
 866   gfc_add_block_to_block (&block, &lse.pre);
 867   gfc_add_block_to_block (&block, &rse.pre);
 868
 869   return gfc_finish_block (&block);
 870 }
 871
 872 static tree
 873 gfc_trans_omp_barrier (void)
 874 {
 875   tree decl = built_in_decls [BUILT_IN_GOMP_BARRIER];
 876   return build_function_call_expr (decl, NULL);
 877 }
 878
 879 static tree
 880 gfc_trans_omp_critical (gfc_code *code)
 881 {
 882   tree name = NULL_TREE, stmt;
 883   if (code->ext.omp_name != NULL)
 884     name = get_identifier (code->ext.omp_name);
 885   stmt = gfc_trans_code (code->block->next);
 886   return build2_v (OMP_CRITICAL, stmt, name);
 887 }
 888
 889 static tree
 890 gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
 891                   gfc_omp_clauses *clauses)
 892 {
 893   gfc_se se;
 894   tree dovar, stmt, from, to, step, type, init, cond, incr;
 895   tree count = NULL_TREE, cycle_label, tmp, omp_clauses;
 896   stmtblock_t block;
 897   stmtblock_t body;
 898   int simple = 0;
 899   bool dovar_found = false;
 900
 901   code = code->block->next;
 902   gcc_assert (code->op == EXEC_DO);
 903
 904   if (pblock == NULL)
 905     {
 906       gfc_start_block (&block);
 907       pblock = &block;
 908     }
 909
 910   omp_clauses = gfc_trans_omp_clauses (pblock, clauses, code->loc);
 911   if (clauses)
 912     {
 913       gfc_namelist *n;
 914       for (n = clauses->lists[OMP_LIST_LASTPRIVATE]; n != NULL; n = n->next)
 915         if (code->ext.iterator->var->symtree->n.sym == n->sym)
 916           break;
 917       if (n == NULL)
 918         for (n = clauses->lists[OMP_LIST_PRIVATE]; n != NULL; n = n->next)
 919           if (code->ext.iterator->var->symtree->n.sym == n->sym)
 920             break;
 921       if (n != NULL)
 922         dovar_found = true;
 923     }
 924
 925   /* Evaluate all the expressions in the iterator.  */
 926   gfc_init_se (&se, NULL);
 927   gfc_conv_expr_lhs (&se, code->ext.iterator->var);
 928   gfc_add_block_to_block (pblock, &se.pre);
 929   dovar = se.expr;
 930   type = TREE_TYPE (dovar);
 931   gcc_assert (TREE_CODE (type) == INTEGER_TYPE);
 932
 933   gfc_init_se (&se, NULL);
 934   gfc_conv_expr_val (&se, code->ext.iterator->start);
 935   gfc_add_block_to_block (pblock, &se.pre);
 936   from = gfc_evaluate_now (se.expr, pblock);
 937
 938   gfc_init_se (&se, NULL);
 939   gfc_conv_expr_val (&se, code->ext.iterator->end);
 940   gfc_add_block_to_block (pblock, &se.pre);
 941   to = gfc_evaluate_now (se.expr, pblock);
 942
 943   gfc_init_se (&se, NULL);
 944   gfc_conv_expr_val (&se, code->ext.iterator->step);
 945   gfc_add_block_to_block (pblock, &se.pre);
 946   step = gfc_evaluate_now (se.expr, pblock);
 947
 948   /* Special case simple loops.  */
 949   if (integer_onep (step))
 950     simple = 1;
 951   else if (tree_int_cst_equal (step, integer_minus_one_node))
 952     simple = -1;
 953
 954   /* Loop body.  */
 955   if (simple)
 956     {
 957       init = build2_v (MODIFY_EXPR, dovar, from);
 958       cond = build2 (simple > 0 ? LE_EXPR : GE_EXPR, boolean_type_node,
 959                      dovar, to);
 960       incr = fold_build2 (PLUS_EXPR, type, dovar, step);
 961       incr = fold_build2 (MODIFY_EXPR, type, dovar, incr);
 962       if (pblock != &block)
 963         {
 964           pushlevel (0);
 965           gfc_start_block (&block);
 966         }
 967       gfc_start_block (&body);
 968     }
 969   else
 970     {
 971       /* STEP is not 1 or -1.  Use:
 972          for (count = 0; count < (to + step - from) / step; count++)
 973            {
 974              dovar = from + count * step;
 975              body;
 976            cycle_label:;
 977            }  */
 978       tmp = fold_build2 (MINUS_EXPR, type, step, from);
 979       tmp = fold_build2 (PLUS_EXPR, type, to, tmp);
 980       tmp = fold_build2 (TRUNC_DIV_EXPR, type, tmp, step);
 981       tmp = gfc_evaluate_now (tmp, pblock);
 982       count = gfc_create_var (type, "count");
 983       init = build2_v (MODIFY_EXPR, count, build_int_cst (type, 0));
 984       cond = build2 (LT_EXPR, boolean_type_node, count, tmp);
 985       incr = fold_build2 (PLUS_EXPR, type, count, build_int_cst (type, 1));
 986       incr = fold_build2 (MODIFY_EXPR, type, count, incr);
 987
 988       if (pblock != &block)
 989         {
 990           pushlevel (0);
 991           gfc_start_block (&block);
 992         }
 993       gfc_start_block (&body);
 994
 995       /* Initialize DOVAR.  */
 996       tmp = fold_build2 (MULT_EXPR, type, count, step);
 997       tmp = build2 (PLUS_EXPR, type, from, tmp);
 998       gfc_add_modify_expr (&body, dovar, tmp);
 999     }
1000
1001   if (!dovar_found)
1002     {
1003       tmp = build_omp_clause (OMP_CLAUSE_PRIVATE);
1004       OMP_CLAUSE_DECL (tmp) = dovar;
1005       omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
1006     }
1007   if (!simple)
1008     {
1009       tmp = build_omp_clause (OMP_CLAUSE_PRIVATE);
1010       OMP_CLAUSE_DECL (tmp) = count;
1011       omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
1012     }
1013
1014   /* Cycle statement is implemented with a goto.  Exit statement must not be
1015      present for this loop.  */
1016   cycle_label = gfc_build_label_decl (NULL_TREE);
1017
1018   /* Put these labels where they can be found later. We put the
1019      labels in a TREE_LIST node (because TREE_CHAIN is already
1020      used). cycle_label goes in TREE_PURPOSE (backend_decl), exit
1021      label in TREE_VALUE (backend_decl).  */
1022
1023   code->block->backend_decl = tree_cons (cycle_label, NULL, NULL);
1024
1025   /* Main loop body.  */
1026   tmp = gfc_trans_omp_code (code->block->next, true);
1027   gfc_add_expr_to_block (&body, tmp);
1028
1029   /* Label for cycle statements (if needed).  */
1030   if (TREE_USED (cycle_label))
1031     {
1032       tmp = build1_v (LABEL_EXPR, cycle_label);
1033       gfc_add_expr_to_block (&body, tmp);
1034     }
1035
1036   /* End of loop body.  */
1037   stmt = make_node (OMP_FOR);
1038
1039   TREE_TYPE (stmt) = void_type_node;
1040   OMP_FOR_BODY (stmt) = gfc_finish_block (&body);
1041   OMP_FOR_CLAUSES (stmt) = omp_clauses;
1042   OMP_FOR_INIT (stmt) = init;
1043   OMP_FOR_COND (stmt) = cond;
1044   OMP_FOR_INCR (stmt) = incr;
1045   gfc_add_expr_to_block (&block, stmt);
1046
1047   return gfc_finish_block (&block);
1048 }
1049
1050 static tree
1051 gfc_trans_omp_flush (void)
1052 {
1053   tree decl = built_in_decls [BUILT_IN_SYNCHRONIZE];
1054   return build_function_call_expr (decl, NULL);
1055 }
1056
1057 static tree
1058 gfc_trans_omp_master (gfc_code *code)
1059 {
1060   tree stmt = gfc_trans_code (code->block->next);
1061   if (IS_EMPTY_STMT (stmt))
1062     return stmt;
1063   return build1_v (OMP_MASTER, stmt);
1064 }
1065
1066 static tree
1067 gfc_trans_omp_ordered (gfc_code *code)
1068 {
1069   return build1_v (OMP_ORDERED, gfc_trans_code (code->block->next));
1070 }
1071
1072 static tree
1073 gfc_trans_omp_parallel (gfc_code *code)
1074 {
1075   stmtblock_t block;
1076   tree stmt, omp_clauses;
1077
1078   gfc_start_block (&block);
1079   omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
1080                                        code->loc);
1081   stmt = gfc_trans_omp_code (code->block->next, true);
1082   stmt = build4_v (OMP_PARALLEL, stmt, omp_clauses, NULL, NULL);
1083   gfc_add_expr_to_block (&block, stmt);
1084   return gfc_finish_block (&block);
1085 }
1086
1087 static tree
1088 gfc_trans_omp_parallel_do (gfc_code *code)
1089 {
1090   stmtblock_t block, *pblock = NULL;
1091   gfc_omp_clauses parallel_clauses, do_clauses;
1092   tree stmt, omp_clauses = NULL_TREE;
1093
1094   gfc_start_block (&block);
1095
1096   memset (&do_clauses, 0, sizeof (do_clauses));
1097   if (code->ext.omp_clauses != NULL)
1098     {
1099       memcpy (&parallel_clauses, code->ext.omp_clauses,
1100               sizeof (parallel_clauses));
1101       do_clauses.sched_kind = parallel_clauses.sched_kind;
1102       do_clauses.chunk_size = parallel_clauses.chunk_size;
1103       do_clauses.ordered = parallel_clauses.ordered;
1104       parallel_clauses.sched_kind = OMP_SCHED_NONE;
1105       parallel_clauses.chunk_size = NULL;
1106       parallel_clauses.ordered = false;
1107       omp_clauses = gfc_trans_omp_clauses (&block, &parallel_clauses,
1108                                            code->loc);
1109     }
1110   do_clauses.nowait = true;
1111   if (!do_clauses.ordered && do_clauses.sched_kind != OMP_SCHED_STATIC)
1112     pblock = &block;
1113   else
1114     pushlevel (0);
1115   stmt = gfc_trans_omp_do (code, pblock, &do_clauses);
1116   if (TREE_CODE (stmt) != BIND_EXPR)
1117     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
1118   else
1119     poplevel (0, 0, 0);
1120   stmt = build4_v (OMP_PARALLEL, stmt, omp_clauses, NULL, NULL);
1121   OMP_PARALLEL_COMBINED (stmt) = 1;
1122   gfc_add_expr_to_block (&block, stmt);
1123   return gfc_finish_block (&block);
1124 }
1125
1126 static tree
1127 gfc_trans_omp_parallel_sections (gfc_code *code)
1128 {
1129   stmtblock_t block;
1130   gfc_omp_clauses section_clauses;
1131   tree stmt, omp_clauses;
1132
1133   memset (&section_clauses, 0, sizeof (section_clauses));
1134   section_clauses.nowait = true;
1135
1136   gfc_start_block (&block);
1137   omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
1138                                        code->loc);
1139   pushlevel (0);
1140   stmt = gfc_trans_omp_sections (code, &section_clauses);
1141   if (TREE_CODE (stmt) != BIND_EXPR)
1142     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
1143   else
1144     poplevel (0, 0, 0);
1145   stmt = build4_v (OMP_PARALLEL, stmt, omp_clauses, NULL, NULL);
1146   OMP_PARALLEL_COMBINED (stmt) = 1;
1147   gfc_add_expr_to_block (&block, stmt);
1148   return gfc_finish_block (&block);
1149 }
1150
1151 static tree
1152 gfc_trans_omp_parallel_workshare (gfc_code *code)
1153 {
1154   stmtblock_t block;
1155   gfc_omp_clauses workshare_clauses;
1156   tree stmt, omp_clauses;
1157
1158   memset (&workshare_clauses, 0, sizeof (workshare_clauses));
1159   workshare_clauses.nowait = true;
1160
1161   gfc_start_block (&block);
1162   omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
1163                                        code->loc);
1164   pushlevel (0);
1165   stmt = gfc_trans_omp_workshare (code, &workshare_clauses);
1166   if (TREE_CODE (stmt) != BIND_EXPR)
1167     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
1168   else
1169     poplevel (0, 0, 0);
1170   stmt = build4_v (OMP_PARALLEL, stmt, omp_clauses, NULL, NULL);
1171   OMP_PARALLEL_COMBINED (stmt) = 1;
1172   gfc_add_expr_to_block (&block, stmt);
1173   return gfc_finish_block (&block);
1174 }
1175
1176 static tree
1177 gfc_trans_omp_sections (gfc_code *code, gfc_omp_clauses *clauses)
1178 {
1179   stmtblock_t block, body;
1180   tree omp_clauses, stmt;
1181   bool has_lastprivate = clauses->lists[OMP_LIST_LASTPRIVATE] != NULL;
1182
1183   gfc_start_block (&block);
1184
1185   omp_clauses = gfc_trans_omp_clauses (&block, clauses, code->loc);
1186
1187   gfc_init_block (&body);
1188   for (code = code->block; code; code = code->block)
1189     {
1190       /* Last section is special because of lastprivate, so even if it
1191          is empty, chain it in.  */
1192       stmt = gfc_trans_omp_code (code->next,
1193                                  has_lastprivate && code->block == NULL);
1194       if (! IS_EMPTY_STMT (stmt))
1195         {
1196           stmt = build1_v (OMP_SECTION, stmt);
1197           gfc_add_expr_to_block (&body, stmt);
1198         }
1199     }
1200   stmt = gfc_finish_block (&body);
1201
1202   stmt = build2_v (OMP_SECTIONS, stmt, omp_clauses);
1203   gfc_add_expr_to_block (&block, stmt);
1204
1205   return gfc_finish_block (&block);
1206 }
1207
1208 static tree
1209 gfc_trans_omp_single (gfc_code *code, gfc_omp_clauses *clauses)
1210 {
1211   tree omp_clauses = gfc_trans_omp_clauses (NULL, clauses, code->loc);
1212   tree stmt = gfc_trans_omp_code (code->block->next, true);
1213   stmt = build2_v (OMP_SINGLE, stmt, omp_clauses);
1214   return stmt;
1215 }
1216
1217 static tree
1218 gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses)
1219 {
1220   /* XXX */
1221   return gfc_trans_omp_single (code, clauses);
1222 }
1223
1224 tree
1225 gfc_trans_omp_directive (gfc_code *code)
1226 {
1227   switch (code->op)
1228     {
1229     case EXEC_OMP_ATOMIC:
1230       return gfc_trans_omp_atomic (code);
1231     case EXEC_OMP_BARRIER:
1232       return gfc_trans_omp_barrier ();
1233     case EXEC_OMP_CRITICAL:
1234       return gfc_trans_omp_critical (code);
1235     case EXEC_OMP_DO:
1236       return gfc_trans_omp_do (code, NULL, code->ext.omp_clauses);
1237     case EXEC_OMP_FLUSH:
1238       return gfc_trans_omp_flush ();
1239     case EXEC_OMP_MASTER:
1240       return gfc_trans_omp_master (code);
1241     case EXEC_OMP_ORDERED:
1242       return gfc_trans_omp_ordered (code);
1243     case EXEC_OMP_PARALLEL:
1244       return gfc_trans_omp_parallel (code);
1245     case EXEC_OMP_PARALLEL_DO:
1246       return gfc_trans_omp_parallel_do (code);
1247     case EXEC_OMP_PARALLEL_SECTIONS:
1248       return gfc_trans_omp_parallel_sections (code);
1249     case EXEC_OMP_PARALLEL_WORKSHARE:
1250       return gfc_trans_omp_parallel_workshare (code);
1251     case EXEC_OMP_SECTIONS:
1252       return gfc_trans_omp_sections (code, code->ext.omp_clauses);
1253     case EXEC_OMP_SINGLE:
1254       return gfc_trans_omp_single (code, code->ext.omp_clauses);
1255     case EXEC_OMP_WORKSHARE:
1256       return gfc_trans_omp_workshare (code, code->ext.omp_clauses);
1257     default:
1258       gcc_unreachable ();
1259     }
1260 }