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