gcc/fortran/trans-openmp.c

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