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, false);
 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, false);
 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 *do_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   gfc_omp_clauses *clauses = code->ext.omp_clauses;
 901
 902   code = code->block->next;
 903   gcc_assert (code->op == EXEC_DO);
 904
 905   if (pblock == NULL)
 906     {
 907       gfc_start_block (&block);
 908       pblock = &block;
 909     }
 910
 911   omp_clauses = gfc_trans_omp_clauses (pblock, do_clauses, code->loc);
 912   if (clauses)
 913     {
 914       gfc_namelist *n;
 915       for (n = clauses->lists[OMP_LIST_LASTPRIVATE]; n != NULL; n = n->next)
 916         if (code->ext.iterator->var->symtree->n.sym == n->sym)
 917           break;
 918       if (n == NULL)
 919         for (n = clauses->lists[OMP_LIST_PRIVATE]; n != NULL; n = n->next)
 920           if (code->ext.iterator->var->symtree->n.sym == n->sym)
 921             break;
 922       if (n != NULL)
 923         dovar_found = true;
 924     }
 925
 926   /* Evaluate all the expressions in the iterator.  */
 927   gfc_init_se (&se, NULL);
 928   gfc_conv_expr_lhs (&se, code->ext.iterator->var);
 929   gfc_add_block_to_block (pblock, &se.pre);
 930   dovar = se.expr;
 931   type = TREE_TYPE (dovar);
 932   gcc_assert (TREE_CODE (type) == INTEGER_TYPE);
 933
 934   gfc_init_se (&se, NULL);
 935   gfc_conv_expr_val (&se, code->ext.iterator->start);
 936   gfc_add_block_to_block (pblock, &se.pre);
 937   from = gfc_evaluate_now (se.expr, pblock);
 938
 939   gfc_init_se (&se, NULL);
 940   gfc_conv_expr_val (&se, code->ext.iterator->end);
 941   gfc_add_block_to_block (pblock, &se.pre);
 942   to = gfc_evaluate_now (se.expr, pblock);
 943
 944   gfc_init_se (&se, NULL);
 945   gfc_conv_expr_val (&se, code->ext.iterator->step);
 946   gfc_add_block_to_block (pblock, &se.pre);
 947   step = gfc_evaluate_now (se.expr, pblock);
 948
 949   /* Special case simple loops.  */
 950   if (integer_onep (step))
 951     simple = 1;
 952   else if (tree_int_cst_equal (step, integer_minus_one_node))
 953     simple = -1;
 954
 955   /* Loop body.  */
 956   if (simple)
 957     {
 958       init = build2_v (MODIFY_EXPR, dovar, from);
 959       cond = build2 (simple > 0 ? LE_EXPR : GE_EXPR, boolean_type_node,
 960                      dovar, to);
 961       incr = fold_build2 (PLUS_EXPR, type, dovar, step);
 962       incr = fold_build2 (MODIFY_EXPR, type, dovar, incr);
 963       if (pblock != &block)
 964         {
 965           pushlevel (0);
 966           gfc_start_block (&block);
 967         }
 968       gfc_start_block (&body);
 969     }
 970   else
 971     {
 972       /* STEP is not 1 or -1.  Use:
 973          for (count = 0; count < (to + step - from) / step; count++)
 974            {
 975              dovar = from + count * step;
 976              body;
 977            cycle_label:;
 978            }  */
 979       tmp = fold_build2 (MINUS_EXPR, type, step, from);
 980       tmp = fold_build2 (PLUS_EXPR, type, to, tmp);
 981       tmp = fold_build2 (TRUNC_DIV_EXPR, type, tmp, step);
 982       tmp = gfc_evaluate_now (tmp, pblock);
 983       count = gfc_create_var (type, "count");
 984       init = build2_v (MODIFY_EXPR, count, build_int_cst (type, 0));
 985       cond = build2 (LT_EXPR, boolean_type_node, count, tmp);
 986       incr = fold_build2 (PLUS_EXPR, type, count, build_int_cst (type, 1));
 987       incr = fold_build2 (MODIFY_EXPR, type, count, incr);
 988
 989       if (pblock != &block)
 990         {
 991           pushlevel (0);
 992           gfc_start_block (&block);
 993         }
 994       gfc_start_block (&body);
 995
 996       /* Initialize DOVAR.  */
 997       tmp = fold_build2 (MULT_EXPR, type, count, step);
 998       tmp = build2 (PLUS_EXPR, type, from, tmp);
 999       gfc_add_modify_expr (&body, dovar, tmp);
1000     }
1001
1002   if (!dovar_found)
1003     {
1004       tmp = build_omp_clause (OMP_CLAUSE_PRIVATE);
1005       OMP_CLAUSE_DECL (tmp) = dovar;
1006       omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
1007     }
1008   if (!simple)
1009     {
1010       tmp = build_omp_clause (OMP_CLAUSE_PRIVATE);
1011       OMP_CLAUSE_DECL (tmp) = count;
1012       omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
1013     }
1014
1015   /* Cycle statement is implemented with a goto.  Exit statement must not be
1016      present for this loop.  */
1017   cycle_label = gfc_build_label_decl (NULL_TREE);
1018
1019   /* Put these labels where they can be found later. We put the
1020      labels in a TREE_LIST node (because TREE_CHAIN is already
1021      used). cycle_label goes in TREE_PURPOSE (backend_decl), exit
1022      label in TREE_VALUE (backend_decl).  */
1023
1024   code->block->backend_decl = tree_cons (cycle_label, NULL, NULL);
1025
1026   /* Main loop body.  */
1027   tmp = gfc_trans_omp_code (code->block->next, true);
1028   gfc_add_expr_to_block (&body, tmp);
1029
1030   /* Label for cycle statements (if needed).  */
1031   if (TREE_USED (cycle_label))
1032     {
1033       tmp = build1_v (LABEL_EXPR, cycle_label);
1034       gfc_add_expr_to_block (&body, tmp);
1035     }
1036
1037   /* End of loop body.  */
1038   stmt = make_node (OMP_FOR);
1039
1040   TREE_TYPE (stmt) = void_type_node;
1041   OMP_FOR_BODY (stmt) = gfc_finish_block (&body);
1042   OMP_FOR_CLAUSES (stmt) = omp_clauses;
1043   OMP_FOR_INIT (stmt) = init;
1044   OMP_FOR_COND (stmt) = cond;
1045   OMP_FOR_INCR (stmt) = incr;
1046   gfc_add_expr_to_block (&block, stmt);
1047
1048   return gfc_finish_block (&block);
1049 }
1050
1051 static tree
1052 gfc_trans_omp_flush (void)
1053 {
1054   tree decl = built_in_decls [BUILT_IN_SYNCHRONIZE];
1055   return build_function_call_expr (decl, NULL);
1056 }
1057
1058 static tree
1059 gfc_trans_omp_master (gfc_code *code)
1060 {
1061   tree stmt = gfc_trans_code (code->block->next);
1062   if (IS_EMPTY_STMT (stmt))
1063     return stmt;
1064   return build1_v (OMP_MASTER, stmt);
1065 }
1066
1067 static tree
1068 gfc_trans_omp_ordered (gfc_code *code)
1069 {
1070   return build1_v (OMP_ORDERED, gfc_trans_code (code->block->next));
1071 }
1072
1073 static tree
1074 gfc_trans_omp_parallel (gfc_code *code)
1075 {
1076   stmtblock_t block;
1077   tree stmt, omp_clauses;
1078
1079   gfc_start_block (&block);
1080   omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
1081                                        code->loc);
1082   stmt = gfc_trans_omp_code (code->block->next, true);
1083   stmt = build4_v (OMP_PARALLEL, stmt, omp_clauses, NULL, NULL);
1084   gfc_add_expr_to_block (&block, stmt);
1085   return gfc_finish_block (&block);
1086 }
1087
1088 static tree
1089 gfc_trans_omp_parallel_do (gfc_code *code)
1090 {
1091   stmtblock_t block, *pblock = NULL;
1092   gfc_omp_clauses parallel_clauses, do_clauses;
1093   tree stmt, omp_clauses = NULL_TREE;
1094
1095   gfc_start_block (&block);
1096
1097   memset (&do_clauses, 0, sizeof (do_clauses));
1098   if (code->ext.omp_clauses != NULL)
1099     {
1100       memcpy (&parallel_clauses, code->ext.omp_clauses,
1101               sizeof (parallel_clauses));
1102       do_clauses.sched_kind = parallel_clauses.sched_kind;
1103       do_clauses.chunk_size = parallel_clauses.chunk_size;
1104       do_clauses.ordered = parallel_clauses.ordered;
1105       parallel_clauses.sched_kind = OMP_SCHED_NONE;
1106       parallel_clauses.chunk_size = NULL;
1107       parallel_clauses.ordered = false;
1108       omp_clauses = gfc_trans_omp_clauses (&block, &parallel_clauses,
1109                                            code->loc);
1110     }
1111   do_clauses.nowait = true;
1112   if (!do_clauses.ordered && do_clauses.sched_kind != OMP_SCHED_STATIC)
1113     pblock = &block;
1114   else
1115     pushlevel (0);
1116   stmt = gfc_trans_omp_do (code, pblock, &do_clauses);
1117   if (TREE_CODE (stmt) != BIND_EXPR)
1118     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
1119   else
1120     poplevel (0, 0, 0);
1121   stmt = build4_v (OMP_PARALLEL, stmt, omp_clauses, NULL, NULL);
1122   OMP_PARALLEL_COMBINED (stmt) = 1;
1123   gfc_add_expr_to_block (&block, stmt);
1124   return gfc_finish_block (&block);
1125 }
1126
1127 static tree
1128 gfc_trans_omp_parallel_sections (gfc_code *code)
1129 {
1130   stmtblock_t block;
1131   gfc_omp_clauses section_clauses;
1132   tree stmt, omp_clauses;
1133
1134   memset (&section_clauses, 0, sizeof (section_clauses));
1135   section_clauses.nowait = true;
1136
1137   gfc_start_block (&block);
1138   omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
1139                                        code->loc);
1140   pushlevel (0);
1141   stmt = gfc_trans_omp_sections (code, &section_clauses);
1142   if (TREE_CODE (stmt) != BIND_EXPR)
1143     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
1144   else
1145     poplevel (0, 0, 0);
1146   stmt = build4_v (OMP_PARALLEL, stmt, omp_clauses, NULL, NULL);
1147   OMP_PARALLEL_COMBINED (stmt) = 1;
1148   gfc_add_expr_to_block (&block, stmt);
1149   return gfc_finish_block (&block);
1150 }
1151
1152 static tree
1153 gfc_trans_omp_parallel_workshare (gfc_code *code)
1154 {
1155   stmtblock_t block;
1156   gfc_omp_clauses workshare_clauses;
1157   tree stmt, omp_clauses;
1158
1159   memset (&workshare_clauses, 0, sizeof (workshare_clauses));
1160   workshare_clauses.nowait = true;
1161
1162   gfc_start_block (&block);
1163   omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
1164                                        code->loc);
1165   pushlevel (0);
1166   stmt = gfc_trans_omp_workshare (code, &workshare_clauses);
1167   if (TREE_CODE (stmt) != BIND_EXPR)
1168     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
1169   else
1170     poplevel (0, 0, 0);
1171   stmt = build4_v (OMP_PARALLEL, stmt, omp_clauses, NULL, NULL);
1172   OMP_PARALLEL_COMBINED (stmt) = 1;
1173   gfc_add_expr_to_block (&block, stmt);
1174   return gfc_finish_block (&block);
1175 }
1176
1177 static tree
1178 gfc_trans_omp_sections (gfc_code *code, gfc_omp_clauses *clauses)
1179 {
1180   stmtblock_t block, body;
1181   tree omp_clauses, stmt;
1182   bool has_lastprivate = clauses->lists[OMP_LIST_LASTPRIVATE] != NULL;
1183
1184   gfc_start_block (&block);
1185
1186   omp_clauses = gfc_trans_omp_clauses (&block, clauses, code->loc);
1187
1188   gfc_init_block (&body);
1189   for (code = code->block; code; code = code->block)
1190     {
1191       /* Last section is special because of lastprivate, so even if it
1192          is empty, chain it in.  */
1193       stmt = gfc_trans_omp_code (code->next,
1194                                  has_lastprivate && code->block == NULL);
1195       if (! IS_EMPTY_STMT (stmt))
1196         {
1197           stmt = build1_v (OMP_SECTION, stmt);
1198           gfc_add_expr_to_block (&body, stmt);
1199         }
1200     }
1201   stmt = gfc_finish_block (&body);
1202
1203   stmt = build2_v (OMP_SECTIONS, stmt, omp_clauses);
1204   gfc_add_expr_to_block (&block, stmt);
1205
1206   return gfc_finish_block (&block);
1207 }
1208
1209 static tree
1210 gfc_trans_omp_single (gfc_code *code, gfc_omp_clauses *clauses)
1211 {
1212   tree omp_clauses = gfc_trans_omp_clauses (NULL, clauses, code->loc);
1213   tree stmt = gfc_trans_omp_code (code->block->next, true);
1214   stmt = build2_v (OMP_SINGLE, stmt, omp_clauses);
1215   return stmt;
1216 }
1217
1218 static tree
1219 gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses)
1220 {
1221   /* XXX */
1222   return gfc_trans_omp_single (code, clauses);
1223 }
1224
1225 tree
1226 gfc_trans_omp_directive (gfc_code *code)
1227 {
1228   switch (code->op)
1229     {
1230     case EXEC_OMP_ATOMIC:
1231       return gfc_trans_omp_atomic (code);
1232     case EXEC_OMP_BARRIER:
1233       return gfc_trans_omp_barrier ();
1234     case EXEC_OMP_CRITICAL:
1235       return gfc_trans_omp_critical (code);
1236     case EXEC_OMP_DO:
1237       return gfc_trans_omp_do (code, NULL, code->ext.omp_clauses);
1238     case EXEC_OMP_FLUSH:
1239       return gfc_trans_omp_flush ();
1240     case EXEC_OMP_MASTER:
1241       return gfc_trans_omp_master (code);
1242     case EXEC_OMP_ORDERED:
1243       return gfc_trans_omp_ordered (code);
1244     case EXEC_OMP_PARALLEL:
1245       return gfc_trans_omp_parallel (code);
1246     case EXEC_OMP_PARALLEL_DO:
1247       return gfc_trans_omp_parallel_do (code);
1248     case EXEC_OMP_PARALLEL_SECTIONS:
1249       return gfc_trans_omp_parallel_sections (code);
1250     case EXEC_OMP_PARALLEL_WORKSHARE:
1251       return gfc_trans_omp_parallel_workshare (code);
1252     case EXEC_OMP_SECTIONS:
1253       return gfc_trans_omp_sections (code, code->ext.omp_clauses);
1254     case EXEC_OMP_SINGLE:
1255       return gfc_trans_omp_single (code, code->ext.omp_clauses);
1256     case EXEC_OMP_WORKSHARE:
1257       return gfc_trans_omp_workshare (code, code->ext.omp_clauses);
1258     default:
1259       gcc_unreachable ();
1260     }
1261 }