LCOV - code coverage report
Current view: top level - gcc/fortran - trans-openmp.c (source / functions) Hit Total Coverage
Test: gcc.info Lines: 3294 3536 93.2 %
Date: 2020-03-28 11:57:23 Functions: 68 74 91.9 %
Legend: Lines: hit not hit | Branches: + taken - not taken # not executed Branches: 0 0 -

           Branch data     Line data    Source code
       1                 :            : /* OpenMP directive translation -- generate GCC trees from gfc_code.
       2                 :            :    Copyright (C) 2005-2020 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 "options.h"
      26                 :            : #include "tree.h"
      27                 :            : #include "gfortran.h"
      28                 :            : #include "gimple-expr.h"
      29                 :            : #include "trans.h"
      30                 :            : #include "stringpool.h"
      31                 :            : #include "fold-const.h"
      32                 :            : #include "gimplify.h" /* For create_tmp_var_raw.  */
      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                 :            : #include "gomp-constants.h"
      39                 :            : #include "omp-general.h"
      40                 :            : #include "omp-low.h"
      41                 :            : #undef GCC_DIAG_STYLE
      42                 :            : #define GCC_DIAG_STYLE __gcc_tdiag__
      43                 :            : #include "diagnostic-core.h"
      44                 :            : #undef GCC_DIAG_STYLE
      45                 :            : #define GCC_DIAG_STYLE __gcc_gfc__
      46                 :            : #include "attribs.h"
      47                 :            : 
      48                 :            : int ompws_flags;
      49                 :            : 
      50                 :            : /* True if OpenMP should regard this DECL as being a scalar which has Fortran's
      51                 :            :    allocatable or pointer attribute.  */
      52                 :            : 
      53                 :            : bool
      54                 :       5548 : gfc_omp_is_allocatable_or_ptr (const_tree decl)
      55                 :            : {
      56                 :       5548 :   return (DECL_P (decl)
      57                 :      10440 :           && (GFC_DECL_GET_SCALAR_POINTER (decl)
      58                 :       3816 :               || GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)));
      59                 :            : }
      60                 :            : 
      61                 :            : /* True if the argument is an optional argument; except that false is also
      62                 :            :    returned for arguments with the value attribute (nonpointers) and for
      63                 :            :    assumed-shape variables (decl is a local variable containing arg->data).
      64                 :            :    Note that pvoid_type_node is for 'type(c_ptr), value.  */
      65                 :            : 
      66                 :            : static bool
      67                 :      38913 : gfc_omp_is_optional_argument (const_tree decl)
      68                 :            : {
      69                 :      38913 :   return (TREE_CODE (decl) == PARM_DECL
      70                 :      12128 :           && DECL_LANG_SPECIFIC (decl)
      71                 :       7530 :           && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE
      72                 :       7470 :           && !VOID_TYPE_P (TREE_TYPE (TREE_TYPE (decl)))
      73                 :      46345 :           && GFC_DECL_OPTIONAL_ARGUMENT (decl));
      74                 :            : }
      75                 :            : 
      76                 :            : /* Check whether this DECL belongs to a Fortran optional argument.
      77                 :            :    With 'for_present_check' set to false, decls which are optional parameters
      78                 :            :    themselve are returned as tree - or a NULL_TREE otherwise. Those decls are
      79                 :            :    always pointers.  With 'for_present_check' set to true, the decl for checking
      80                 :            :    whether an argument is present is returned; for arguments with value
      81                 :            :    attribute this is the hidden argument and of BOOLEAN_TYPE.  If the decl is
      82                 :            :    unrelated to optional arguments, NULL_TREE is returned.  */
      83                 :            : 
      84                 :            : tree
      85                 :      15723 : gfc_omp_check_optional_argument (tree decl, bool for_present_check)
      86                 :            : {
      87                 :      15723 :   if (!for_present_check)
      88                 :       1778 :     return gfc_omp_is_optional_argument (decl) ? decl : NULL_TREE;
      89                 :            : 
      90                 :      13945 :   if (!DECL_LANG_SPECIFIC (decl))
      91                 :            :     return NULL_TREE;
      92                 :            : 
      93                 :       3568 :   bool is_array_type = false;
      94                 :            : 
      95                 :            :   /* For assumed-shape arrays, a local decl with arg->data is used.  */
      96                 :       3568 :   if (TREE_CODE (decl) != PARM_DECL
      97                 :       4462 :       && (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))
      98                 :        894 :           || GFC_ARRAY_TYPE_P (TREE_TYPE (decl))))
      99                 :            :     {
     100                 :        489 :       is_array_type = true;
     101                 :        489 :       decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
     102                 :            :     }
     103                 :            : 
     104                 :       3568 :   if (decl == NULL_TREE
     105                 :       3566 :       || TREE_CODE (decl) != PARM_DECL
     106                 :       3161 :       || !DECL_LANG_SPECIFIC (decl)
     107                 :       6415 :       || !GFC_DECL_OPTIONAL_ARGUMENT (decl))
     108                 :            :     return NULL_TREE;
     109                 :            : 
     110                 :            :    /* Scalars with VALUE attribute which are passed by value use a hidden
     111                 :            :       argument to denote the present status.  They are passed as nonpointer type
     112                 :            :       with one exception: 'type(c_ptr), value' as 'void*'.  */
     113                 :            :    /* Cf. trans-expr.c's gfc_conv_expr_present.  */
     114                 :       2475 :    if (TREE_CODE (TREE_TYPE (decl)) != POINTER_TYPE
     115                 :       2475 :        || VOID_TYPE_P (TREE_TYPE (TREE_TYPE (decl))))
     116                 :            :     {
     117                 :        134 :       char name[GFC_MAX_SYMBOL_LEN + 2];
     118                 :        134 :       tree tree_name;
     119                 :            : 
     120                 :        134 :       name[0] = '_';
     121                 :        134 :       strcpy (&name[1], IDENTIFIER_POINTER (DECL_NAME (decl)));
     122                 :        134 :       tree_name = get_identifier (name);
     123                 :            : 
     124                 :            :       /* Walk function argument list to find the hidden arg.  */
     125                 :        134 :       decl = DECL_ARGUMENTS (DECL_CONTEXT (decl));
     126                 :        769 :       for ( ; decl != NULL_TREE; decl = TREE_CHAIN (decl))
     127                 :        769 :         if (DECL_NAME (decl) == tree_name
     128                 :        903 :             && DECL_ARTIFICIAL (decl))
     129                 :            :           break;
     130                 :            : 
     131                 :        134 :       gcc_assert (decl);
     132                 :        134 :       return decl;
     133                 :            :     }
     134                 :            : 
     135                 :       2341 :   tree cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
     136                 :            :                                decl, null_pointer_node);
     137                 :            : 
     138                 :            :   /* Fortran regards unallocated allocatables/disassociated pointer which
     139                 :            :      are passed to a nonallocatable, nonpointer argument as not associated;
     140                 :            :      cf. F2018, 15.5.2.12, Paragraph 1.  */
     141                 :       2341 :   if (is_array_type)
     142                 :            :     {
     143                 :        173 :       tree cond2 = build_fold_indirect_ref_loc (input_location, decl);
     144                 :        173 :       cond2 = gfc_conv_array_data (cond2);
     145                 :        173 :       cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
     146                 :            :                                cond2, null_pointer_node);
     147                 :        173 :       cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
     148                 :            :                               boolean_type_node, cond, cond2);
     149                 :            :     }
     150                 :            : 
     151                 :            :   return cond;
     152                 :            : }
     153                 :            : 
     154                 :            : 
     155                 :            : /* Returns tree with NULL if it is not an array descriptor and with the tree to
     156                 :            :    access the 'data' component otherwise.  With type_only = true, it returns the
     157                 :            :    TREE_TYPE without creating a new tree.  */
     158                 :            : 
     159                 :            : tree
     160                 :       9130 : gfc_omp_array_data (tree decl, bool type_only)
     161                 :            : {
     162                 :       9130 :   tree type = TREE_TYPE (decl);
     163                 :            : 
     164                 :       9130 :   if (POINTER_TYPE_P (type))
     165                 :       6250 :     type = TREE_TYPE (type);
     166                 :            : 
     167                 :       9130 :   if (!GFC_DESCRIPTOR_TYPE_P (type))
     168                 :            :     return NULL_TREE;
     169                 :            : 
     170                 :       4059 :   if (type_only)
     171                 :       2937 :     return GFC_TYPE_ARRAY_DATAPTR_TYPE (type);
     172                 :            : 
     173                 :       1122 :   if (POINTER_TYPE_P (TREE_TYPE (decl)))
     174                 :        375 :     decl = build_fold_indirect_ref (decl);
     175                 :            : 
     176                 :       1122 :   decl = gfc_conv_descriptor_data_get (decl);
     177                 :       1122 :   STRIP_NOPS (decl);
     178                 :       1122 :   return decl;
     179                 :            : }
     180                 :            : 
     181                 :            : /* True if OpenMP should privatize what this DECL points to rather
     182                 :            :    than the DECL itself.  */
     183                 :            : 
     184                 :            : bool
     185                 :     333615 : gfc_omp_privatize_by_reference (const_tree decl)
     186                 :            : {
     187                 :     333615 :   tree type = TREE_TYPE (decl);
     188                 :            : 
     189                 :     333615 :   if (TREE_CODE (type) == REFERENCE_TYPE
     190                 :     345964 :       && (!DECL_ARTIFICIAL (decl) || TREE_CODE (decl) == PARM_DECL))
     191                 :            :     return true;
     192                 :            : 
     193                 :     321273 :   if (TREE_CODE (type) == POINTER_TYPE
     194                 :     321273 :       && gfc_omp_is_optional_argument (decl))
     195                 :            :     return true;
     196                 :            : 
     197                 :     314768 :   if (TREE_CODE (type) == POINTER_TYPE)
     198                 :            :     {
     199                 :      28848 :       while (TREE_CODE (decl) == COMPONENT_REF)
     200                 :          0 :         decl = TREE_OPERAND (decl, 1);
     201                 :            : 
     202                 :            :       /* Array POINTER/ALLOCATABLE have aggregate types, all user variables
     203                 :            :          that have POINTER_TYPE type and aren't scalar pointers, scalar
     204                 :            :          allocatables, Cray pointees or C pointers are supposed to be
     205                 :            :          privatized by reference.  */
     206                 :      28848 :       if (GFC_DECL_GET_SCALAR_POINTER (decl)
     207                 :      27613 :           || GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
     208                 :      25669 :           || GFC_DECL_CRAY_POINTEE (decl)
     209                 :      25663 :           || GFC_DECL_ASSOCIATE_VAR_P (decl)
     210                 :      33686 :           || VOID_TYPE_P (TREE_TYPE (TREE_TYPE (decl))))
     211                 :            :         return false;
     212                 :            : 
     213                 :      20787 :       if (!DECL_ARTIFICIAL (decl)
     214                 :      26655 :           && TREE_CODE (TREE_TYPE (type)) != FUNCTION_TYPE)
     215                 :            :         return true;
     216                 :            : 
     217                 :            :       /* Some arrays are expanded as DECL_ARTIFICIAL pointers
     218                 :            :          by the frontend.  */
     219                 :      15145 :       if (DECL_LANG_SPECIFIC (decl)
     220                 :      15145 :           && GFC_DECL_SAVED_DESCRIPTOR (decl))
     221                 :       4628 :         return true;
     222                 :            :     }
     223                 :            : 
     224                 :            :   return false;
     225                 :            : }
     226                 :            : 
     227                 :            : /* True if OpenMP sharing attribute of DECL is predetermined.  */
     228                 :            : 
     229                 :            : enum omp_clause_default_kind
     230                 :       4471 : gfc_omp_predetermined_sharing (tree decl)
     231                 :            : {
     232                 :            :   /* Associate names preserve the association established during ASSOCIATE.
     233                 :            :      As they are implemented either as pointers to the selector or array
     234                 :            :      descriptor and shouldn't really change in the ASSOCIATE region,
     235                 :            :      this decl can be either shared or firstprivate.  If it is a pointer,
     236                 :            :      use firstprivate, as it is cheaper that way, otherwise make it shared.  */
     237                 :       4471 :   if (GFC_DECL_ASSOCIATE_VAR_P (decl))
     238                 :            :     {
     239                 :         42 :       if (TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE)
     240                 :            :         return OMP_CLAUSE_DEFAULT_FIRSTPRIVATE;
     241                 :            :       else
     242                 :         18 :         return OMP_CLAUSE_DEFAULT_SHARED;
     243                 :            :     }
     244                 :            : 
     245                 :       4429 :   if (DECL_ARTIFICIAL (decl)
     246                 :       1004 :       && ! GFC_DECL_RESULT (decl)
     247                 :       5433 :       && ! (DECL_LANG_SPECIFIC (decl)
     248                 :         91 :             && GFC_DECL_SAVED_DESCRIPTOR (decl)))
     249                 :            :     return OMP_CLAUSE_DEFAULT_SHARED;
     250                 :            : 
     251                 :            :   /* Cray pointees shouldn't be listed in any clauses and should be
     252                 :            :      gimplified to dereference of the corresponding Cray pointer.
     253                 :            :      Make them all private, so that they are emitted in the debug
     254                 :            :      information.  */
     255                 :       3514 :   if (GFC_DECL_CRAY_POINTEE (decl))
     256                 :            :     return OMP_CLAUSE_DEFAULT_PRIVATE;
     257                 :            : 
     258                 :            :   /* Assumed-size arrays are predetermined shared.  */
     259                 :       3478 :   if (TREE_CODE (decl) == PARM_DECL
     260                 :        833 :       && GFC_ARRAY_TYPE_P (TREE_TYPE (decl))
     261                 :        432 :       && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (decl)) == GFC_ARRAY_UNKNOWN
     262                 :       3910 :       && GFC_TYPE_ARRAY_UBOUND (TREE_TYPE (decl),
     263                 :            :                                 GFC_TYPE_ARRAY_RANK (TREE_TYPE (decl)) - 1)
     264                 :            :          == NULL)
     265                 :            :     return OMP_CLAUSE_DEFAULT_SHARED;
     266                 :            : 
     267                 :            :   /* Dummy procedures aren't considered variables by OpenMP, thus are
     268                 :            :      disallowed in OpenMP clauses.  They are represented as PARM_DECLs
     269                 :            :      in the middle-end, so return OMP_CLAUSE_DEFAULT_FIRSTPRIVATE here
     270                 :            :      to avoid complaining about their uses with default(none).  */
     271                 :       3448 :   if (TREE_CODE (decl) == PARM_DECL
     272                 :        803 :       && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE
     273                 :       3853 :       && TREE_CODE (TREE_TYPE (TREE_TYPE (decl))) == FUNCTION_TYPE)
     274                 :            :     return OMP_CLAUSE_DEFAULT_FIRSTPRIVATE;
     275                 :            : 
     276                 :            :   /* COMMON and EQUIVALENCE decls are shared.  They
     277                 :            :      are only referenced through DECL_VALUE_EXPR of the variables
     278                 :            :      contained in them.  If those are privatized, they will not be
     279                 :            :      gimplified to the COMMON or EQUIVALENCE decls.  */
     280                 :       3563 :   if (GFC_DECL_COMMON_OR_EQUIV (decl) && ! DECL_HAS_VALUE_EXPR_P (decl))
     281                 :            :     return OMP_CLAUSE_DEFAULT_SHARED;
     282                 :            : 
     283                 :       3415 :   if (GFC_DECL_RESULT (decl) && ! DECL_HAS_VALUE_EXPR_P (decl))
     284                 :            :     return OMP_CLAUSE_DEFAULT_SHARED;
     285                 :            : 
     286                 :            :   /* These are either array or derived parameters, or vtables.
     287                 :            :      In the former cases, the OpenMP standard doesn't consider them to be
     288                 :            :      variables at all (they can't be redefined), but they can nevertheless appear
     289                 :            :      in parallel/task regions and for default(none) purposes treat them as shared.
     290                 :            :      For vtables likely the same handling is desirable.  */
     291                 :       2614 :   if (VAR_P (decl) && TREE_READONLY (decl)
     292                 :       3418 :       && (TREE_STATIC (decl) || DECL_EXTERNAL (decl)))
     293                 :          3 :     return OMP_CLAUSE_DEFAULT_SHARED;
     294                 :            : 
     295                 :            :   return OMP_CLAUSE_DEFAULT_UNSPECIFIED;
     296                 :            : }
     297                 :            : 
     298                 :            : /* Return decl that should be used when reporting DEFAULT(NONE)
     299                 :            :    diagnostics.  */
     300                 :            : 
     301                 :            : tree
     302                 :         27 : gfc_omp_report_decl (tree decl)
     303                 :            : {
     304                 :         27 :   if (DECL_ARTIFICIAL (decl)
     305                 :          2 :       && DECL_LANG_SPECIFIC (decl)
     306                 :         29 :       && GFC_DECL_SAVED_DESCRIPTOR (decl))
     307                 :         27 :     return GFC_DECL_SAVED_DESCRIPTOR (decl);
     308                 :            : 
     309                 :            :   return decl;
     310                 :            : }
     311                 :            : 
     312                 :            : /* Return true if TYPE has any allocatable components.  */
     313                 :            : 
     314                 :            : static bool
     315                 :      67506 : gfc_has_alloc_comps (tree type, tree decl)
     316                 :            : {
     317                 :      67506 :   tree field, ftype;
     318                 :            : 
     319                 :      67506 :   if (POINTER_TYPE_P (type))
     320                 :            :     {
     321                 :       3045 :       if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl))
     322                 :       2274 :         type = TREE_TYPE (type);
     323                 :        771 :       else if (GFC_DECL_GET_SCALAR_POINTER (decl))
     324                 :            :         return false;
     325                 :            :     }
     326                 :            : 
     327                 :      67378 :   if (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type))
     328                 :       6445 :     type = gfc_get_element_type (type);
     329                 :            : 
     330                 :      67378 :   if (TREE_CODE (type) != RECORD_TYPE)
     331                 :            :     return false;
     332                 :            : 
     333                 :       5968 :   for (field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field))
     334                 :            :     {
     335                 :       5510 :       ftype = TREE_TYPE (field);
     336                 :       5510 :       if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field))
     337                 :            :         return true;
     338                 :       5510 :       if (GFC_DESCRIPTOR_TYPE_P (ftype)
     339                 :       5510 :           && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE)
     340                 :            :         return true;
     341                 :       3782 :       if (gfc_has_alloc_comps (ftype, field))
     342                 :            :         return true;
     343                 :            :     }
     344                 :            :   return false;
     345                 :            : }
     346                 :            : 
     347                 :            : /* Return true if DECL in private clause needs
     348                 :            :    OMP_CLAUSE_PRIVATE_OUTER_REF on the private clause.  */
     349                 :            : bool
     350                 :      11177 : gfc_omp_private_outer_ref (tree decl)
     351                 :            : {
     352                 :      11177 :   tree type = TREE_TYPE (decl);
     353                 :            : 
     354                 :      11177 :   if (gfc_omp_privatize_by_reference (decl))
     355                 :        446 :     type = TREE_TYPE (type);
     356                 :            : 
     357                 :      11177 :   if (GFC_DESCRIPTOR_TYPE_P (type)
     358                 :      11177 :       && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE)
     359                 :            :     return true;
     360                 :            : 
     361                 :      11051 :   if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl))
     362                 :            :     return true;
     363                 :            : 
     364                 :      10977 :   if (gfc_has_alloc_comps (type, decl))
     365                 :         50 :     return true;
     366                 :            : 
     367                 :            :   return false;
     368                 :            : }
     369                 :            : 
     370                 :            : /* Callback for gfc_omp_unshare_expr.  */
     371                 :            : 
     372                 :            : static tree
     373                 :      92098 : gfc_omp_unshare_expr_r (tree *tp, int *walk_subtrees, void *)
     374                 :            : {
     375                 :      92098 :   tree t = *tp;
     376                 :      92098 :   enum tree_code code = TREE_CODE (t);
     377                 :            : 
     378                 :            :   /* Stop at types, decls, constants like copy_tree_r.  */
     379                 :      92098 :   if (TREE_CODE_CLASS (code) == tcc_type
     380                 :            :       || TREE_CODE_CLASS (code) == tcc_declaration
     381                 :      92098 :       || TREE_CODE_CLASS (code) == tcc_constant
     382                 :      61054 :       || code == BLOCK)
     383                 :      31044 :     *walk_subtrees = 0;
     384                 :      61054 :   else if (handled_component_p (t)
     385                 :      46149 :            || TREE_CODE (t) == MEM_REF)
     386                 :            :     {
     387                 :      14961 :       *tp = unshare_expr (t);
     388                 :      14961 :       *walk_subtrees = 0;
     389                 :            :     }
     390                 :            : 
     391                 :      92098 :   return NULL_TREE;
     392                 :            : }
     393                 :            : 
     394                 :            : /* Unshare in expr anything that the FE which normally doesn't
     395                 :            :    care much about tree sharing (because during gimplification
     396                 :            :    everything is unshared) could cause problems with tree sharing
     397                 :            :    at omp-low.c time.  */
     398                 :            : 
     399                 :            : static tree
     400                 :       5048 : gfc_omp_unshare_expr (tree expr)
     401                 :            : {
     402                 :          0 :   walk_tree (&expr, gfc_omp_unshare_expr_r, NULL, NULL);
     403                 :       5048 :   return expr;
     404                 :            : }
     405                 :            : 
     406                 :            : enum walk_alloc_comps
     407                 :            : {
     408                 :            :   WALK_ALLOC_COMPS_DTOR,
     409                 :            :   WALK_ALLOC_COMPS_DEFAULT_CTOR,
     410                 :            :   WALK_ALLOC_COMPS_COPY_CTOR
     411                 :            : };
     412                 :            : 
     413                 :            : /* Handle allocatable components in OpenMP clauses.  */
     414                 :            : 
     415                 :            : static tree
     416                 :       2800 : gfc_walk_alloc_comps (tree decl, tree dest, tree var,
     417                 :            :                       enum walk_alloc_comps kind)
     418                 :            : {
     419                 :       2800 :   stmtblock_t block, tmpblock;
     420                 :       2800 :   tree type = TREE_TYPE (decl), then_b, tem, field;
     421                 :       2800 :   gfc_init_block (&block);
     422                 :            : 
     423                 :       2800 :   if (GFC_ARRAY_TYPE_P (type) || GFC_DESCRIPTOR_TYPE_P (type))
     424                 :            :     {
     425                 :       1092 :       if (GFC_DESCRIPTOR_TYPE_P (type))
     426                 :            :         {
     427                 :        548 :           gfc_init_block (&tmpblock);
     428                 :        548 :           tem = gfc_full_array_size (&tmpblock, decl,
     429                 :        548 :                                      GFC_TYPE_ARRAY_RANK (type));
     430                 :        548 :           then_b = gfc_finish_block (&tmpblock);
     431                 :        548 :           gfc_add_expr_to_block (&block, gfc_omp_unshare_expr (then_b));
     432                 :        548 :           tem = gfc_omp_unshare_expr (tem);
     433                 :        548 :           tem = fold_build2_loc (input_location, MINUS_EXPR,
     434                 :            :                                  gfc_array_index_type, tem,
     435                 :            :                                  gfc_index_one_node);
     436                 :            :         }
     437                 :            :       else
     438                 :            :         {
     439                 :        544 :           bool compute_nelts = false;
     440                 :        544 :           if (!TYPE_DOMAIN (type)
     441                 :        544 :               || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == NULL_TREE
     442                 :        544 :               || TYPE_MIN_VALUE (TYPE_DOMAIN (type)) == error_mark_node
     443                 :       1088 :               || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == error_mark_node)
     444                 :            :             compute_nelts = true;
     445                 :        544 :           else if (VAR_P (TYPE_MAX_VALUE (TYPE_DOMAIN (type))))
     446                 :            :             {
     447                 :         80 :               tree a = DECL_ATTRIBUTES (TYPE_MAX_VALUE (TYPE_DOMAIN (type)));
     448                 :         80 :               if (lookup_attribute ("omp dummy var", a))
     449                 :            :                 compute_nelts = true;
     450                 :            :             }
     451                 :            :           if (compute_nelts)
     452                 :            :             {
     453                 :         80 :               tem = fold_build2 (EXACT_DIV_EXPR, sizetype,
     454                 :            :                                  TYPE_SIZE_UNIT (type),
     455                 :            :                                  TYPE_SIZE_UNIT (TREE_TYPE (type)));
     456                 :         80 :               tem = size_binop (MINUS_EXPR, tem, size_one_node);
     457                 :            :             }
     458                 :            :           else
     459                 :        464 :             tem = array_type_nelts (type);
     460                 :        544 :           tem = fold_convert (gfc_array_index_type, tem);
     461                 :            :         }
     462                 :            : 
     463                 :       1092 :       tree nelems = gfc_evaluate_now (tem, &block);
     464                 :       1092 :       tree index = gfc_create_var (gfc_array_index_type, "S");
     465                 :            : 
     466                 :       1092 :       gfc_init_block (&tmpblock);
     467                 :       1092 :       tem = gfc_conv_array_data (decl);
     468                 :       1092 :       tree declvar = build_fold_indirect_ref_loc (input_location, tem);
     469                 :       1092 :       tree declvref = gfc_build_array_ref (declvar, index, NULL);
     470                 :       1092 :       tree destvar, destvref = NULL_TREE;
     471                 :       1092 :       if (dest)
     472                 :            :         {
     473                 :        546 :           tem = gfc_conv_array_data (dest);
     474                 :        546 :           destvar = build_fold_indirect_ref_loc (input_location, tem);
     475                 :        546 :           destvref = gfc_build_array_ref (destvar, index, NULL);
     476                 :            :         }
     477                 :       1092 :       gfc_add_expr_to_block (&tmpblock,
     478                 :            :                              gfc_walk_alloc_comps (declvref, destvref,
     479                 :            :                                                    var, kind));
     480                 :            : 
     481                 :       1092 :       gfc_loopinfo loop;
     482                 :       1092 :       gfc_init_loopinfo (&loop);
     483                 :       1092 :       loop.dimen = 1;
     484                 :       1092 :       loop.from[0] = gfc_index_zero_node;
     485                 :       1092 :       loop.loopvar[0] = index;
     486                 :       1092 :       loop.to[0] = nelems;
     487                 :       1092 :       gfc_trans_scalarizing_loops (&loop, &tmpblock);
     488                 :       1092 :       gfc_add_block_to_block (&block, &loop.pre);
     489                 :       1092 :       return gfc_finish_block (&block);
     490                 :            :     }
     491                 :       1708 :   else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (var))
     492                 :            :     {
     493                 :        536 :       decl = build_fold_indirect_ref_loc (input_location, decl);
     494                 :        536 :       if (dest)
     495                 :        268 :         dest = build_fold_indirect_ref_loc (input_location, dest);
     496                 :        536 :       type = TREE_TYPE (decl);
     497                 :            :     }
     498                 :            : 
     499                 :       1708 :   gcc_assert (TREE_CODE (type) == RECORD_TYPE);
     500                 :      11484 :   for (field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field))
     501                 :            :     {
     502                 :       9776 :       tree ftype = TREE_TYPE (field);
     503                 :       9776 :       tree declf, destf = NULL_TREE;
     504                 :       9776 :       bool has_alloc_comps = gfc_has_alloc_comps (ftype, field);
     505                 :       9776 :       if ((!GFC_DESCRIPTOR_TYPE_P (ftype)
     506                 :       1708 :            || GFC_TYPE_ARRAY_AKIND (ftype) != GFC_ARRAY_ALLOCATABLE)
     507                 :       8068 :           && !GFC_DECL_GET_SCALAR_ALLOCATABLE (field)
     508                 :      16148 :           && !has_alloc_comps)
     509                 :       5948 :         continue;
     510                 :       3828 :       declf = fold_build3_loc (input_location, COMPONENT_REF, ftype,
     511                 :            :                                decl, field, NULL_TREE);
     512                 :       3828 :       if (dest)
     513                 :       1914 :         destf = fold_build3_loc (input_location, COMPONENT_REF, ftype,
     514                 :            :                                  dest, field, NULL_TREE);
     515                 :            : 
     516                 :       3828 :       tem = NULL_TREE;
     517                 :       3828 :       switch (kind)
     518                 :            :         {
     519                 :            :         case WALK_ALLOC_COMPS_DTOR:
     520                 :            :           break;
     521                 :        960 :         case WALK_ALLOC_COMPS_DEFAULT_CTOR:
     522                 :        960 :           if (GFC_DESCRIPTOR_TYPE_P (ftype)
     523                 :        960 :               && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE)
     524                 :            :             {
     525                 :        430 :               gfc_add_modify (&block, unshare_expr (destf),
     526                 :            :                               unshare_expr (declf));
     527                 :        430 :               tem = gfc_duplicate_allocatable_nocopy
     528                 :        430 :                                         (destf, declf, ftype,
     529                 :        430 :                                          GFC_TYPE_ARRAY_RANK (ftype));
     530                 :            :             }
     531                 :        530 :           else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field))
     532                 :        424 :             tem = gfc_duplicate_allocatable_nocopy (destf, declf, ftype, 0);
     533                 :            :           break;
     534                 :        954 :         case WALK_ALLOC_COMPS_COPY_CTOR:
     535                 :        954 :           if (GFC_DESCRIPTOR_TYPE_P (ftype)
     536                 :        954 :               && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE)
     537                 :        424 :             tem = gfc_duplicate_allocatable (destf, declf, ftype,
     538                 :        424 :                                              GFC_TYPE_ARRAY_RANK (ftype),
     539                 :            :                                              NULL_TREE);
     540                 :        530 :           else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field))
     541                 :        424 :             tem = gfc_duplicate_allocatable (destf, declf, ftype, 0,
     542                 :            :                                              NULL_TREE);
     543                 :            :           break;
     544                 :            :         }
     545                 :       1702 :       if (tem)
     546                 :       1702 :         gfc_add_expr_to_block (&block, gfc_omp_unshare_expr (tem));
     547                 :       3828 :       if (has_alloc_comps)
     548                 :            :         {
     549                 :       1272 :           gfc_init_block (&tmpblock);
     550                 :       1272 :           gfc_add_expr_to_block (&tmpblock,
     551                 :            :                                  gfc_walk_alloc_comps (declf, destf,
     552                 :            :                                                        field, kind));
     553                 :       1272 :           then_b = gfc_finish_block (&tmpblock);
     554                 :       1272 :           if (GFC_DESCRIPTOR_TYPE_P (ftype)
     555                 :       1272 :               && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE)
     556                 :        424 :             tem = gfc_conv_descriptor_data_get (unshare_expr (declf));
     557                 :        848 :           else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field))
     558                 :        424 :             tem = unshare_expr (declf);
     559                 :            :           else
     560                 :            :             tem = NULL_TREE;
     561                 :        848 :           if (tem)
     562                 :            :             {
     563                 :        848 :               tem = fold_convert (pvoid_type_node, tem);
     564                 :        848 :               tem = fold_build2_loc (input_location, NE_EXPR,
     565                 :            :                                      logical_type_node, tem,
     566                 :            :                                      null_pointer_node);
     567                 :        848 :               then_b = build3_loc (input_location, COND_EXPR, void_type_node,
     568                 :            :                                    tem, then_b,
     569                 :            :                                    build_empty_stmt (input_location));
     570                 :            :             }
     571                 :       1272 :           gfc_add_expr_to_block (&block, then_b);
     572                 :            :         }
     573                 :       3828 :       if (kind == WALK_ALLOC_COMPS_DTOR)
     574                 :            :         {
     575                 :       1914 :           if (GFC_DESCRIPTOR_TYPE_P (ftype)
     576                 :       1914 :               && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE)
     577                 :            :             {
     578                 :        854 :               tem = gfc_conv_descriptor_data_get (unshare_expr (declf));
     579                 :        854 :               tem = gfc_deallocate_with_status (tem, NULL_TREE, NULL_TREE,
     580                 :            :                                                 NULL_TREE, NULL_TREE, true,
     581                 :            :                                                 NULL,
     582                 :            :                                                 GFC_CAF_COARRAY_NOCOARRAY);
     583                 :        854 :               gfc_add_expr_to_block (&block, gfc_omp_unshare_expr (tem));
     584                 :            :             }
     585                 :       1060 :           else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field))
     586                 :            :             {
     587                 :        848 :               tem = gfc_call_free (unshare_expr (declf));
     588                 :        848 :               gfc_add_expr_to_block (&block, gfc_omp_unshare_expr (tem));
     589                 :            :             }
     590                 :            :         }
     591                 :            :     }
     592                 :            : 
     593                 :       1708 :   return gfc_finish_block (&block);
     594                 :            : }
     595                 :            : 
     596                 :            : /* Return code to initialize DECL with its default constructor, or
     597                 :            :    NULL if there's nothing to do.  */
     598                 :            : 
     599                 :            : tree
     600                 :      12507 : gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer)
     601                 :            : {
     602                 :      12507 :   tree type = TREE_TYPE (decl), size, ptr, cond, then_b, else_b;
     603                 :      12507 :   stmtblock_t block, cond_block;
     604                 :            : 
     605                 :      12507 :   gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_PRIVATE
     606                 :            :               || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LASTPRIVATE
     607                 :            :               || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR
     608                 :            :               || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_REDUCTION);
     609                 :            : 
     610                 :      12507 :   if ((! GFC_DESCRIPTOR_TYPE_P (type)
     611                 :        262 :        || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
     612                 :      12525 :       && (!GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))
     613                 :         73 :           || !POINTER_TYPE_P (type)))
     614                 :            :     {
     615                 :      12190 :       if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
     616                 :            :         {
     617                 :         50 :           gcc_assert (outer);
     618                 :         50 :           gfc_start_block (&block);
     619                 :        100 :           tree tem = gfc_walk_alloc_comps (outer, decl,
     620                 :         50 :                                            OMP_CLAUSE_DECL (clause),
     621                 :            :                                            WALK_ALLOC_COMPS_DEFAULT_CTOR);
     622                 :         50 :           gfc_add_expr_to_block (&block, tem);
     623                 :         50 :           return gfc_finish_block (&block);
     624                 :            :         }
     625                 :            :       return NULL_TREE;
     626                 :            :     }
     627                 :            : 
     628                 :        317 :   gcc_assert (outer != NULL_TREE);
     629                 :            : 
     630                 :            :   /* Allocatable arrays and scalars in PRIVATE clauses need to be set to
     631                 :            :      "not currently allocated" allocation status if outer
     632                 :            :      array is "not currently allocated", otherwise should be allocated.  */
     633                 :        317 :   gfc_start_block (&block);
     634                 :            : 
     635                 :        317 :   gfc_init_block (&cond_block);
     636                 :            : 
     637                 :        317 :   if (GFC_DESCRIPTOR_TYPE_P (type))
     638                 :            :     {
     639                 :        244 :       gfc_add_modify (&cond_block, decl, outer);
     640                 :        244 :       tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
     641                 :        244 :       size = gfc_conv_descriptor_ubound_get (decl, rank);
     642                 :        244 :       size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
     643                 :            :                               size,
     644                 :            :                               gfc_conv_descriptor_lbound_get (decl, rank));
     645                 :        244 :       size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
     646                 :            :                               size, gfc_index_one_node);
     647                 :        244 :       if (GFC_TYPE_ARRAY_RANK (type) > 1)
     648                 :        130 :         size = fold_build2_loc (input_location, MULT_EXPR,
     649                 :            :                                 gfc_array_index_type, size,
     650                 :            :                                 gfc_conv_descriptor_stride_get (decl, rank));
     651                 :        244 :       tree esize = fold_convert (gfc_array_index_type,
     652                 :            :                                  TYPE_SIZE_UNIT (gfc_get_element_type (type)));
     653                 :        244 :       size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
     654                 :            :                               size, esize);
     655                 :        244 :       size = unshare_expr (size);
     656                 :        244 :       size = gfc_evaluate_now (fold_convert (size_type_node, size),
     657                 :            :                                &cond_block);
     658                 :            :     }
     659                 :            :   else
     660                 :         73 :     size = fold_convert (size_type_node, TYPE_SIZE_UNIT (TREE_TYPE (type)));
     661                 :        317 :   ptr = gfc_create_var (pvoid_type_node, NULL);
     662                 :        317 :   gfc_allocate_using_malloc (&cond_block, ptr, size, NULL_TREE);
     663                 :        317 :   if (GFC_DESCRIPTOR_TYPE_P (type))
     664                 :        244 :     gfc_conv_descriptor_data_set (&cond_block, unshare_expr (decl), ptr);
     665                 :            :   else
     666                 :        146 :     gfc_add_modify (&cond_block, unshare_expr (decl),
     667                 :         73 :                     fold_convert (TREE_TYPE (decl), ptr));
     668                 :        317 :   if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
     669                 :            :     {
     670                 :        124 :       tree tem = gfc_walk_alloc_comps (outer, decl,
     671                 :         62 :                                        OMP_CLAUSE_DECL (clause),
     672                 :            :                                        WALK_ALLOC_COMPS_DEFAULT_CTOR);
     673                 :         62 :       gfc_add_expr_to_block (&cond_block, tem);
     674                 :            :     }
     675                 :        317 :   then_b = gfc_finish_block (&cond_block);
     676                 :            : 
     677                 :            :   /* Reduction clause requires allocated ALLOCATABLE.  */
     678                 :        317 :   if (OMP_CLAUSE_CODE (clause) != OMP_CLAUSE_REDUCTION)
     679                 :            :     {
     680                 :        173 :       gfc_init_block (&cond_block);
     681                 :        173 :       if (GFC_DESCRIPTOR_TYPE_P (type))
     682                 :        124 :         gfc_conv_descriptor_data_set (&cond_block, unshare_expr (decl),
     683                 :            :                                       null_pointer_node);
     684                 :            :       else
     685                 :         98 :         gfc_add_modify (&cond_block, unshare_expr (decl),
     686                 :         49 :                         build_zero_cst (TREE_TYPE (decl)));
     687                 :        173 :       else_b = gfc_finish_block (&cond_block);
     688                 :            : 
     689                 :        173 :       tree tem = fold_convert (pvoid_type_node,
     690                 :            :                                GFC_DESCRIPTOR_TYPE_P (type)
     691                 :            :                                ? gfc_conv_descriptor_data_get (outer) : outer);
     692                 :        173 :       tem = unshare_expr (tem);
     693                 :        173 :       cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
     694                 :            :                               tem, null_pointer_node);
     695                 :        346 :       gfc_add_expr_to_block (&block,
     696                 :            :                              build3_loc (input_location, COND_EXPR,
     697                 :            :                                          void_type_node, cond, then_b,
     698                 :            :                                          else_b));
     699                 :            :       /* Avoid -W*uninitialized warnings.  */
     700                 :        173 :       if (DECL_P (decl))
     701                 :        144 :         TREE_NO_WARNING (decl) = 1;
     702                 :            :     }
     703                 :            :   else
     704                 :        144 :     gfc_add_expr_to_block (&block, then_b);
     705                 :            : 
     706                 :        317 :   return gfc_finish_block (&block);
     707                 :            : }
     708                 :            : 
     709                 :            : /* Build and return code for a copy constructor from SRC to DEST.  */
     710                 :            : 
     711                 :            : tree
     712                 :       6787 : gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
     713                 :            : {
     714                 :       6787 :   tree type = TREE_TYPE (dest), ptr, size, call;
     715                 :       6787 :   tree cond, then_b, else_b;
     716                 :       6787 :   stmtblock_t block, cond_block;
     717                 :            : 
     718                 :       6787 :   gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_FIRSTPRIVATE
     719                 :            :               || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR);
     720                 :            : 
     721                 :       6787 :   if ((! GFC_DESCRIPTOR_TYPE_P (type)
     722                 :        133 :        || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
     723                 :       6811 :       && (!GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))
     724                 :         76 :           || !POINTER_TYPE_P (type)))
     725                 :            :     {
     726                 :       6604 :       if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
     727                 :            :         {
     728                 :         20 :           gfc_start_block (&block);
     729                 :         20 :           gfc_add_modify (&block, dest, src);
     730                 :         20 :           tree tem = gfc_walk_alloc_comps (src, dest, OMP_CLAUSE_DECL (clause),
     731                 :            :                                            WALK_ALLOC_COMPS_COPY_CTOR);
     732                 :         20 :           gfc_add_expr_to_block (&block, tem);
     733                 :         20 :           return gfc_finish_block (&block);
     734                 :            :         }
     735                 :            :       else
     736                 :       6584 :         return build2_v (MODIFY_EXPR, dest, src);
     737                 :            :     }
     738                 :            : 
     739                 :            :   /* Allocatable arrays in FIRSTPRIVATE clauses need to be allocated
     740                 :            :      and copied from SRC.  */
     741                 :        183 :   gfc_start_block (&block);
     742                 :            : 
     743                 :        183 :   gfc_init_block (&cond_block);
     744                 :            : 
     745                 :        183 :   gfc_add_modify (&cond_block, dest, src);
     746                 :        183 :   if (GFC_DESCRIPTOR_TYPE_P (type))
     747                 :            :     {
     748                 :        109 :       tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
     749                 :        109 :       size = gfc_conv_descriptor_ubound_get (dest, rank);
     750                 :        109 :       size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
     751                 :            :                               size,
     752                 :            :                               gfc_conv_descriptor_lbound_get (dest, rank));
     753                 :        109 :       size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
     754                 :            :                               size, gfc_index_one_node);
     755                 :        109 :       if (GFC_TYPE_ARRAY_RANK (type) > 1)
     756                 :         42 :         size = fold_build2_loc (input_location, MULT_EXPR,
     757                 :            :                                 gfc_array_index_type, size,
     758                 :            :                                 gfc_conv_descriptor_stride_get (dest, rank));
     759                 :        109 :       tree esize = fold_convert (gfc_array_index_type,
     760                 :            :                                  TYPE_SIZE_UNIT (gfc_get_element_type (type)));
     761                 :        109 :       size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
     762                 :            :                               size, esize);
     763                 :        109 :       size = unshare_expr (size);
     764                 :        109 :       size = gfc_evaluate_now (fold_convert (size_type_node, size),
     765                 :            :                                &cond_block);
     766                 :            :     }
     767                 :            :   else
     768                 :         74 :     size = fold_convert (size_type_node, TYPE_SIZE_UNIT (TREE_TYPE (type)));
     769                 :        183 :   ptr = gfc_create_var (pvoid_type_node, NULL);
     770                 :        183 :   gfc_allocate_using_malloc (&cond_block, ptr, size, NULL_TREE);
     771                 :        183 :   if (GFC_DESCRIPTOR_TYPE_P (type))
     772                 :        109 :     gfc_conv_descriptor_data_set (&cond_block, unshare_expr (dest), ptr);
     773                 :            :   else
     774                 :        148 :     gfc_add_modify (&cond_block, unshare_expr (dest),
     775                 :         74 :                     fold_convert (TREE_TYPE (dest), ptr));
     776                 :            : 
     777                 :        183 :   tree srcptr = GFC_DESCRIPTOR_TYPE_P (type)
     778                 :        183 :                 ? gfc_conv_descriptor_data_get (src) : src;
     779                 :        183 :   srcptr = unshare_expr (srcptr);
     780                 :        183 :   srcptr = fold_convert (pvoid_type_node, srcptr);
     781                 :        183 :   call = build_call_expr_loc (input_location,
     782                 :            :                               builtin_decl_explicit (BUILT_IN_MEMCPY), 3, ptr,
     783                 :            :                               srcptr, size);
     784                 :        183 :   gfc_add_expr_to_block (&cond_block, fold_convert (void_type_node, call));
     785                 :        183 :   if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
     786                 :            :     {
     787                 :         48 :       tree tem = gfc_walk_alloc_comps (src, dest,
     788                 :         24 :                                        OMP_CLAUSE_DECL (clause),
     789                 :            :                                        WALK_ALLOC_COMPS_COPY_CTOR);
     790                 :         24 :       gfc_add_expr_to_block (&cond_block, tem);
     791                 :            :     }
     792                 :        183 :   then_b = gfc_finish_block (&cond_block);
     793                 :            : 
     794                 :        183 :   gfc_init_block (&cond_block);
     795                 :        183 :   if (GFC_DESCRIPTOR_TYPE_P (type))
     796                 :        109 :     gfc_conv_descriptor_data_set (&cond_block, unshare_expr (dest),
     797                 :            :                                   null_pointer_node);
     798                 :            :   else
     799                 :        148 :     gfc_add_modify (&cond_block, unshare_expr (dest),
     800                 :         74 :                     build_zero_cst (TREE_TYPE (dest)));
     801                 :        183 :   else_b = gfc_finish_block (&cond_block);
     802                 :            : 
     803                 :        183 :   cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
     804                 :            :                           unshare_expr (srcptr), null_pointer_node);
     805                 :        366 :   gfc_add_expr_to_block (&block,
     806                 :            :                          build3_loc (input_location, COND_EXPR,
     807                 :            :                                      void_type_node, cond, then_b, else_b));
     808                 :            :   /* Avoid -W*uninitialized warnings.  */
     809                 :        183 :   if (DECL_P (dest))
     810                 :        117 :     TREE_NO_WARNING (dest) = 1;
     811                 :            : 
     812                 :        183 :   return gfc_finish_block (&block);
     813                 :            : }
     814                 :            : 
     815                 :            : /* Similarly, except use an intrinsic or pointer assignment operator
     816                 :            :    instead.  */
     817                 :            : 
     818                 :            : tree
     819                 :       3437 : gfc_omp_clause_assign_op (tree clause, tree dest, tree src)
     820                 :            : {
     821                 :       3437 :   tree type = TREE_TYPE (dest), ptr, size, call, nonalloc;
     822                 :       3437 :   tree cond, then_b, else_b;
     823                 :       3437 :   stmtblock_t block, cond_block, cond_block2, inner_block;
     824                 :            : 
     825                 :       3437 :   if ((! GFC_DESCRIPTOR_TYPE_P (type)
     826                 :        234 :        || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
     827                 :       6671 :       && (!GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))
     828                 :        130 :           || !POINTER_TYPE_P (type)))
     829                 :            :     {
     830                 :       3104 :       if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
     831                 :            :         {
     832                 :         30 :           gfc_start_block (&block);
     833                 :            :           /* First dealloc any allocatable components in DEST.  */
     834                 :         60 :           tree tem = gfc_walk_alloc_comps (dest, NULL_TREE,
     835                 :         30 :                                            OMP_CLAUSE_DECL (clause),
     836                 :            :                                            WALK_ALLOC_COMPS_DTOR);
     837                 :         30 :           gfc_add_expr_to_block (&block, tem);
     838                 :            :           /* Then copy over toplevel data.  */
     839                 :         30 :           gfc_add_modify (&block, dest, src);
     840                 :            :           /* Finally allocate any allocatable components and copy.  */
     841                 :         30 :           tem = gfc_walk_alloc_comps (src, dest, OMP_CLAUSE_DECL (clause),
     842                 :            :                                            WALK_ALLOC_COMPS_COPY_CTOR);
     843                 :         30 :           gfc_add_expr_to_block (&block, tem);
     844                 :         30 :           return gfc_finish_block (&block);
     845                 :            :         }
     846                 :            :       else
     847                 :       3074 :         return build2_v (MODIFY_EXPR, dest, src);
     848                 :            :     }
     849                 :            : 
     850                 :        333 :   gfc_start_block (&block);
     851                 :            : 
     852                 :        333 :   if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
     853                 :            :     {
     854                 :         32 :       then_b = gfc_walk_alloc_comps (dest, NULL_TREE, OMP_CLAUSE_DECL (clause),
     855                 :            :                                      WALK_ALLOC_COMPS_DTOR);
     856                 :         32 :       tree tem = fold_convert (pvoid_type_node,
     857                 :            :                                GFC_DESCRIPTOR_TYPE_P (type)
     858                 :            :                                ? gfc_conv_descriptor_data_get (dest) : dest);
     859                 :         32 :       tem = unshare_expr (tem);
     860                 :         32 :       cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
     861                 :            :                               tem, null_pointer_node);
     862                 :         32 :       tem = build3_loc (input_location, COND_EXPR, void_type_node, cond,
     863                 :            :                         then_b, build_empty_stmt (input_location));
     864                 :         32 :       gfc_add_expr_to_block (&block, tem);
     865                 :            :     }
     866                 :            : 
     867                 :        333 :   gfc_init_block (&cond_block);
     868                 :            : 
     869                 :        333 :   if (GFC_DESCRIPTOR_TYPE_P (type))
     870                 :            :     {
     871                 :        203 :       tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
     872                 :        203 :       size = gfc_conv_descriptor_ubound_get (src, rank);
     873                 :        203 :       size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
     874                 :            :                               size,
     875                 :            :                               gfc_conv_descriptor_lbound_get (src, rank));
     876                 :        203 :       size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
     877                 :            :                               size, gfc_index_one_node);
     878                 :        203 :       if (GFC_TYPE_ARRAY_RANK (type) > 1)
     879                 :         88 :         size = fold_build2_loc (input_location, MULT_EXPR,
     880                 :            :                                 gfc_array_index_type, size,
     881                 :            :                                 gfc_conv_descriptor_stride_get (src, rank));
     882                 :        203 :       tree esize = fold_convert (gfc_array_index_type,
     883                 :            :                                  TYPE_SIZE_UNIT (gfc_get_element_type (type)));
     884                 :        203 :       size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
     885                 :            :                               size, esize);
     886                 :        203 :       size = unshare_expr (size);
     887                 :        203 :       size = gfc_evaluate_now (fold_convert (size_type_node, size),
     888                 :            :                                &cond_block);
     889                 :            :     }
     890                 :            :   else
     891                 :        130 :     size = fold_convert (size_type_node, TYPE_SIZE_UNIT (TREE_TYPE (type)));
     892                 :        333 :   ptr = gfc_create_var (pvoid_type_node, NULL);
     893                 :            : 
     894                 :        333 :   tree destptr = GFC_DESCRIPTOR_TYPE_P (type)
     895                 :        333 :                  ? gfc_conv_descriptor_data_get (dest) : dest;
     896                 :        333 :   destptr = unshare_expr (destptr);
     897                 :        333 :   destptr = fold_convert (pvoid_type_node, destptr);
     898                 :        333 :   gfc_add_modify (&cond_block, ptr, destptr);
     899                 :            : 
     900                 :        333 :   nonalloc = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
     901                 :            :                               destptr, null_pointer_node);
     902                 :        333 :   cond = nonalloc;
     903                 :        333 :   if (GFC_DESCRIPTOR_TYPE_P (type))
     904                 :            :     {
     905                 :            :       int i;
     906                 :        494 :       for (i = 0; i < GFC_TYPE_ARRAY_RANK (type); i++)
     907                 :            :         {
     908                 :        291 :           tree rank = gfc_rank_cst[i];
     909                 :        291 :           tree tem = gfc_conv_descriptor_ubound_get (src, rank);
     910                 :        291 :           tem = fold_build2_loc (input_location, MINUS_EXPR,
     911                 :            :                                  gfc_array_index_type, tem,
     912                 :            :                                  gfc_conv_descriptor_lbound_get (src, rank));
     913                 :        291 :           tem = fold_build2_loc (input_location, PLUS_EXPR,
     914                 :            :                                  gfc_array_index_type, tem,
     915                 :            :                                  gfc_conv_descriptor_lbound_get (dest, rank));
     916                 :        291 :           tem = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
     917                 :            :                                  tem, gfc_conv_descriptor_ubound_get (dest,
     918                 :            :                                                                       rank));
     919                 :        291 :           cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR,
     920                 :            :                                   logical_type_node, cond, tem);
     921                 :            :         }
     922                 :            :     }
     923                 :            : 
     924                 :        333 :   gfc_init_block (&cond_block2);
     925                 :            : 
     926                 :        333 :   if (GFC_DESCRIPTOR_TYPE_P (type))
     927                 :            :     {
     928                 :        203 :       gfc_init_block (&inner_block);
     929                 :        203 :       gfc_allocate_using_malloc (&inner_block, ptr, size, NULL_TREE);
     930                 :        203 :       then_b = gfc_finish_block (&inner_block);
     931                 :            : 
     932                 :        203 :       gfc_init_block (&inner_block);
     933                 :        203 :       gfc_add_modify (&inner_block, ptr,
     934                 :            :                       gfc_call_realloc (&inner_block, ptr, size));
     935                 :        203 :       else_b = gfc_finish_block (&inner_block);
     936                 :            : 
     937                 :        406 :       gfc_add_expr_to_block (&cond_block2,
     938                 :            :                              build3_loc (input_location, COND_EXPR,
     939                 :            :                                          void_type_node,
     940                 :            :                                          unshare_expr (nonalloc),
     941                 :            :                                          then_b, else_b));
     942                 :        203 :       gfc_add_modify (&cond_block2, dest, src);
     943                 :        203 :       gfc_conv_descriptor_data_set (&cond_block2, unshare_expr (dest), ptr);
     944                 :            :     }
     945                 :            :   else
     946                 :            :     {
     947                 :        130 :       gfc_allocate_using_malloc (&cond_block2, ptr, size, NULL_TREE);
     948                 :        130 :       gfc_add_modify (&cond_block2, unshare_expr (dest),
     949                 :            :                       fold_convert (type, ptr));
     950                 :            :     }
     951                 :        333 :   then_b = gfc_finish_block (&cond_block2);
     952                 :        333 :   else_b = build_empty_stmt (input_location);
     953                 :            : 
     954                 :        666 :   gfc_add_expr_to_block (&cond_block,
     955                 :            :                          build3_loc (input_location, COND_EXPR,
     956                 :            :                                      void_type_node, unshare_expr (cond),
     957                 :            :                                      then_b, else_b));
     958                 :            : 
     959                 :        333 :   tree srcptr = GFC_DESCRIPTOR_TYPE_P (type)
     960                 :        333 :                 ? gfc_conv_descriptor_data_get (src) : src;
     961                 :        333 :   srcptr = unshare_expr (srcptr);
     962                 :        333 :   srcptr = fold_convert (pvoid_type_node, srcptr);
     963                 :        333 :   call = build_call_expr_loc (input_location,
     964                 :            :                               builtin_decl_explicit (BUILT_IN_MEMCPY), 3, ptr,
     965                 :            :                               srcptr, size);
     966                 :        333 :   gfc_add_expr_to_block (&cond_block, fold_convert (void_type_node, call));
     967                 :        333 :   if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
     968                 :            :     {
     969                 :         64 :       tree tem = gfc_walk_alloc_comps (src, dest,
     970                 :         32 :                                        OMP_CLAUSE_DECL (clause),
     971                 :            :                                        WALK_ALLOC_COMPS_COPY_CTOR);
     972                 :         32 :       gfc_add_expr_to_block (&cond_block, tem);
     973                 :            :     }
     974                 :        333 :   then_b = gfc_finish_block (&cond_block);
     975                 :            : 
     976                 :        333 :   if (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_COPYIN)
     977                 :            :     {
     978                 :         66 :       gfc_init_block (&cond_block);
     979                 :         66 :       if (GFC_DESCRIPTOR_TYPE_P (type))
     980                 :            :         {
     981                 :         48 :           tree tmp = gfc_conv_descriptor_data_get (unshare_expr (dest));
     982                 :         48 :           tmp = gfc_deallocate_with_status (tmp, NULL_TREE, NULL_TREE,
     983                 :            :                                             NULL_TREE, NULL_TREE, true, NULL,
     984                 :            :                                             GFC_CAF_COARRAY_NOCOARRAY);
     985                 :         48 :           gfc_add_expr_to_block (&cond_block, tmp);
     986                 :            :         }
     987                 :            :       else
     988                 :            :         {
     989                 :         18 :           destptr = gfc_evaluate_now (destptr, &cond_block);
     990                 :         18 :           gfc_add_expr_to_block (&cond_block, gfc_call_free (destptr));
     991                 :         36 :           gfc_add_modify (&cond_block, unshare_expr (dest),
     992                 :         18 :                           build_zero_cst (TREE_TYPE (dest)));
     993                 :            :         }
     994                 :         66 :       else_b = gfc_finish_block (&cond_block);
     995                 :            : 
     996                 :         66 :       cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
     997                 :            :                               unshare_expr (srcptr), null_pointer_node);
     998                 :        132 :       gfc_add_expr_to_block (&block,
     999                 :            :                              build3_loc (input_location, COND_EXPR,
    1000                 :            :                                          void_type_node, cond,
    1001                 :            :                                          then_b, else_b));
    1002                 :            :     }
    1003                 :            :   else
    1004                 :        267 :     gfc_add_expr_to_block (&block, then_b);
    1005                 :            : 
    1006                 :        333 :   return gfc_finish_block (&block);
    1007                 :            : }
    1008                 :            : 
    1009                 :            : static void
    1010                 :         84 : gfc_omp_linear_clause_add_loop (stmtblock_t *block, tree dest, tree src,
    1011                 :            :                                 tree add, tree nelems)
    1012                 :            : {
    1013                 :         84 :   stmtblock_t tmpblock;
    1014                 :         84 :   tree desta, srca, index = gfc_create_var (gfc_array_index_type, "S");
    1015                 :         84 :   nelems = gfc_evaluate_now (nelems, block);
    1016                 :            : 
    1017                 :         84 :   gfc_init_block (&tmpblock);
    1018                 :         84 :   if (TREE_CODE (TREE_TYPE (dest)) == ARRAY_TYPE)
    1019                 :            :     {
    1020                 :         60 :       desta = gfc_build_array_ref (dest, index, NULL);
    1021                 :         60 :       srca = gfc_build_array_ref (src, index, NULL);
    1022                 :            :     }
    1023                 :            :   else
    1024                 :            :     {
    1025                 :         24 :       gcc_assert (POINTER_TYPE_P (TREE_TYPE (dest)));
    1026                 :         24 :       tree idx = fold_build2 (MULT_EXPR, sizetype,
    1027                 :            :                               fold_convert (sizetype, index),
    1028                 :            :                               TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (dest))));
    1029                 :         24 :       desta = build_fold_indirect_ref (fold_build2 (POINTER_PLUS_EXPR,
    1030                 :            :                                                     TREE_TYPE (dest), dest,
    1031                 :            :                                                     idx));
    1032                 :         24 :       srca = build_fold_indirect_ref (fold_build2 (POINTER_PLUS_EXPR,
    1033                 :            :                                                    TREE_TYPE (src), src,
    1034                 :            :                                                     idx));
    1035                 :            :     }
    1036                 :        168 :   gfc_add_modify (&tmpblock, desta,
    1037                 :         84 :                   fold_build2 (PLUS_EXPR, TREE_TYPE (desta),
    1038                 :            :                                srca, add));
    1039                 :            : 
    1040                 :         84 :   gfc_loopinfo loop;
    1041                 :         84 :   gfc_init_loopinfo (&loop);
    1042                 :         84 :   loop.dimen = 1;
    1043                 :         84 :   loop.from[0] = gfc_index_zero_node;
    1044                 :         84 :   loop.loopvar[0] = index;
    1045                 :         84 :   loop.to[0] = nelems;
    1046                 :         84 :   gfc_trans_scalarizing_loops (&loop, &tmpblock);
    1047                 :         84 :   gfc_add_block_to_block (block, &loop.pre);
    1048                 :         84 : }
    1049                 :            : 
    1050                 :            : /* Build and return code for a constructor of DEST that initializes
    1051                 :            :    it to SRC plus ADD (ADD is scalar integer).  */
    1052                 :            : 
    1053                 :            : tree
    1054                 :        108 : gfc_omp_clause_linear_ctor (tree clause, tree dest, tree src, tree add)
    1055                 :            : {
    1056                 :        108 :   tree type = TREE_TYPE (dest), ptr, size, nelems = NULL_TREE;
    1057                 :        108 :   stmtblock_t block;
    1058                 :            : 
    1059                 :        108 :   gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR);
    1060                 :            : 
    1061                 :        108 :   gfc_start_block (&block);
    1062                 :        108 :   add = gfc_evaluate_now (add, &block);
    1063                 :            : 
    1064                 :        108 :   if ((! GFC_DESCRIPTOR_TYPE_P (type)
    1065                 :         24 :        || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
    1066                 :        192 :       && (!GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))
    1067                 :         24 :           || !POINTER_TYPE_P (type)))
    1068                 :            :     {
    1069                 :         60 :       bool compute_nelts = false;
    1070                 :         60 :       gcc_assert (TREE_CODE (type) == ARRAY_TYPE);
    1071                 :         60 :       if (!TYPE_DOMAIN (type)
    1072                 :         60 :           || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == NULL_TREE
    1073                 :         60 :           || TYPE_MIN_VALUE (TYPE_DOMAIN (type)) == error_mark_node
    1074                 :        120 :           || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == error_mark_node)
    1075                 :            :         compute_nelts = true;
    1076                 :         60 :       else if (VAR_P (TYPE_MAX_VALUE (TYPE_DOMAIN (type))))
    1077                 :            :         {
    1078                 :         48 :           tree a = DECL_ATTRIBUTES (TYPE_MAX_VALUE (TYPE_DOMAIN (type)));
    1079                 :         48 :           if (lookup_attribute ("omp dummy var", a))
    1080                 :            :             compute_nelts = true;
    1081                 :            :         }
    1082                 :            :       if (compute_nelts)
    1083                 :            :         {
    1084                 :         48 :           nelems = fold_build2 (EXACT_DIV_EXPR, sizetype,
    1085                 :            :                                 TYPE_SIZE_UNIT (type),
    1086                 :            :                                 TYPE_SIZE_UNIT (TREE_TYPE (type)));
    1087                 :         48 :           nelems = size_binop (MINUS_EXPR, nelems, size_one_node);
    1088                 :            :         }
    1089                 :            :       else
    1090                 :         12 :         nelems = array_type_nelts (type);
    1091                 :         60 :       nelems = fold_convert (gfc_array_index_type, nelems);
    1092                 :            : 
    1093                 :         60 :       gfc_omp_linear_clause_add_loop (&block, dest, src, add, nelems);
    1094                 :         60 :       return gfc_finish_block (&block);
    1095                 :            :     }
    1096                 :            : 
    1097                 :            :   /* Allocatable arrays in LINEAR clauses need to be allocated
    1098                 :            :      and copied from SRC.  */
    1099                 :         48 :   gfc_add_modify (&block, dest, src);
    1100                 :         48 :   if (GFC_DESCRIPTOR_TYPE_P (type))
    1101                 :            :     {
    1102                 :         24 :       tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
    1103                 :         24 :       size = gfc_conv_descriptor_ubound_get (dest, rank);
    1104                 :         24 :       size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
    1105                 :            :                               size,
    1106                 :            :                               gfc_conv_descriptor_lbound_get (dest, rank));
    1107                 :         24 :       size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
    1108                 :            :                               size, gfc_index_one_node);
    1109                 :         24 :       if (GFC_TYPE_ARRAY_RANK (type) > 1)
    1110                 :          0 :         size = fold_build2_loc (input_location, MULT_EXPR,
    1111                 :            :                                 gfc_array_index_type, size,
    1112                 :            :                                 gfc_conv_descriptor_stride_get (dest, rank));
    1113                 :         24 :       tree esize = fold_convert (gfc_array_index_type,
    1114                 :            :                                  TYPE_SIZE_UNIT (gfc_get_element_type (type)));
    1115                 :         24 :       nelems = gfc_evaluate_now (unshare_expr (size), &block);
    1116                 :         24 :       size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
    1117                 :            :                               nelems, unshare_expr (esize));
    1118                 :         24 :       size = gfc_evaluate_now (fold_convert (size_type_node, size),
    1119                 :            :                                &block);
    1120                 :         24 :       nelems = fold_build2_loc (input_location, MINUS_EXPR,
    1121                 :            :                                 gfc_array_index_type, nelems,
    1122                 :            :                                 gfc_index_one_node);
    1123                 :            :     }
    1124                 :            :   else
    1125                 :         24 :     size = fold_convert (size_type_node, TYPE_SIZE_UNIT (TREE_TYPE (type)));
    1126                 :         48 :   ptr = gfc_create_var (pvoid_type_node, NULL);
    1127                 :         48 :   gfc_allocate_using_malloc (&block, ptr, size, NULL_TREE);
    1128                 :         48 :   if (GFC_DESCRIPTOR_TYPE_P (type))
    1129                 :            :     {
    1130                 :         24 :       gfc_conv_descriptor_data_set (&block, unshare_expr (dest), ptr);
    1131                 :         24 :       tree etype = gfc_get_element_type (type);
    1132                 :         24 :       ptr = fold_convert (build_pointer_type (etype), ptr);
    1133                 :         24 :       tree srcptr = gfc_conv_descriptor_data_get (unshare_expr (src));
    1134                 :         24 :       srcptr = fold_convert (build_pointer_type (etype), srcptr);
    1135                 :         24 :       gfc_omp_linear_clause_add_loop (&block, ptr, srcptr, add, nelems);
    1136                 :            :     }
    1137                 :            :   else
    1138                 :            :     {
    1139                 :         48 :       gfc_add_modify (&block, unshare_expr (dest),
    1140                 :         24 :                       fold_convert (TREE_TYPE (dest), ptr));
    1141                 :         24 :       ptr = fold_convert (TREE_TYPE (dest), ptr);
    1142                 :         24 :       tree dstm = build_fold_indirect_ref (ptr);
    1143                 :         24 :       tree srcm = build_fold_indirect_ref (unshare_expr (src));
    1144                 :         48 :       gfc_add_modify (&block, dstm,
    1145                 :         24 :                       fold_build2 (PLUS_EXPR, TREE_TYPE (add), srcm, add));
    1146                 :            :     }
    1147                 :         48 :   return gfc_finish_block (&block);
    1148                 :            : }
    1149                 :            : 
    1150                 :            : /* Build and return code destructing DECL.  Return NULL if nothing
    1151                 :            :    to be done.  */
    1152                 :            : 
    1153                 :            : tree
    1154                 :      19907 : gfc_omp_clause_dtor (tree clause, tree decl)
    1155                 :            : {
    1156                 :      19907 :   tree type = TREE_TYPE (decl), tem;
    1157                 :            : 
    1158                 :      19907 :   if ((! GFC_DESCRIPTOR_TYPE_P (type)
    1159                 :        427 :        || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
    1160                 :      39437 :       && (!GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))
    1161                 :        173 :           || !POINTER_TYPE_P (type)))
    1162                 :            :     {
    1163                 :      19359 :       if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
    1164                 :        140 :         return gfc_walk_alloc_comps (decl, NULL_TREE,
    1165                 :         70 :                                      OMP_CLAUSE_DECL (clause),
    1166                 :         70 :                                      WALK_ALLOC_COMPS_DTOR);
    1167                 :            :       return NULL_TREE;
    1168                 :            :     }
    1169                 :            : 
    1170                 :        548 :   if (GFC_DESCRIPTOR_TYPE_P (type))
    1171                 :            :     {
    1172                 :            :       /* Allocatable arrays in FIRSTPRIVATE/LASTPRIVATE etc. clauses need
    1173                 :            :          to be deallocated if they were allocated.  */
    1174                 :        377 :       tem = gfc_conv_descriptor_data_get (decl);
    1175                 :        377 :       tem = gfc_deallocate_with_status (tem, NULL_TREE, NULL_TREE, NULL_TREE,
    1176                 :            :                                         NULL_TREE, true, NULL,
    1177                 :            :                                         GFC_CAF_COARRAY_NOCOARRAY);
    1178                 :            :     }
    1179                 :            :   else
    1180                 :        171 :     tem = gfc_call_free (decl);
    1181                 :        548 :   tem = gfc_omp_unshare_expr (tem);
    1182                 :            : 
    1183                 :        548 :   if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
    1184                 :            :     {
    1185                 :         86 :       stmtblock_t block;
    1186                 :         86 :       tree then_b;
    1187                 :            : 
    1188                 :         86 :       gfc_init_block (&block);
    1189                 :        172 :       gfc_add_expr_to_block (&block,
    1190                 :            :                              gfc_walk_alloc_comps (decl, NULL_TREE,
    1191                 :         86 :                                                    OMP_CLAUSE_DECL (clause),
    1192                 :            :                                                    WALK_ALLOC_COMPS_DTOR));
    1193                 :         86 :       gfc_add_expr_to_block (&block, tem);
    1194                 :         86 :       then_b = gfc_finish_block (&block);
    1195                 :            : 
    1196                 :         86 :       tem = fold_convert (pvoid_type_node,
    1197                 :            :                           GFC_DESCRIPTOR_TYPE_P (type)
    1198                 :            :                           ? gfc_conv_descriptor_data_get (decl) : decl);
    1199                 :         86 :       tem = unshare_expr (tem);
    1200                 :         86 :       tree cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
    1201                 :            :                                    tem, null_pointer_node);
    1202                 :        172 :       tem = build3_loc (input_location, COND_EXPR, void_type_node, cond,
    1203                 :            :                         then_b, build_empty_stmt (input_location));
    1204                 :            :     }
    1205                 :            :   return tem;
    1206                 :            : }
    1207                 :            : 
    1208                 :            : /* Build a conditional expression in BLOCK.  If COND_VAL is not
    1209                 :            :    null, then the block THEN_B is executed, otherwise ELSE_VAL
    1210                 :            :    is assigned to VAL.  */
    1211                 :            : 
    1212                 :            : static void
    1213                 :       1029 : gfc_build_cond_assign (stmtblock_t *block, tree val, tree cond_val,
    1214                 :            :                        tree then_b, tree else_val)
    1215                 :            : {
    1216                 :       1029 :   stmtblock_t cond_block;
    1217                 :       1029 :   tree else_b = NULL_TREE;
    1218                 :       1029 :   tree val_ty = TREE_TYPE (val);
    1219                 :            : 
    1220                 :       1029 :   if (else_val)
    1221                 :            :     {
    1222                 :       1029 :       gfc_init_block (&cond_block);
    1223                 :       1029 :       gfc_add_modify (&cond_block, val, fold_convert (val_ty, else_val));
    1224                 :       1029 :       else_b = gfc_finish_block (&cond_block);
    1225                 :            :     }
    1226                 :       2058 :   gfc_add_expr_to_block (block,
    1227                 :            :                          build3_loc (input_location, COND_EXPR, void_type_node,
    1228                 :            :                                      cond_val, then_b, else_b));
    1229                 :       1029 : }
    1230                 :            : 
    1231                 :            : /* Build a conditional expression in BLOCK, returning a temporary
    1232                 :            :    variable containing the result.  If COND_VAL is not null, then
    1233                 :            :    THEN_VAL will be assigned to the variable, otherwise ELSE_VAL
    1234                 :            :    is assigned.
    1235                 :            :  */
    1236                 :            : 
    1237                 :            : static tree
    1238                 :        963 : gfc_build_cond_assign_expr (stmtblock_t *block, tree cond_val,
    1239                 :            :                             tree then_val, tree else_val)
    1240                 :            : {
    1241                 :        963 :   tree val;
    1242                 :        963 :   tree val_ty = TREE_TYPE (then_val);
    1243                 :        963 :   stmtblock_t cond_block;
    1244                 :            : 
    1245                 :        963 :   val = create_tmp_var (val_ty);
    1246                 :            : 
    1247                 :        963 :   gfc_init_block (&cond_block);
    1248                 :        963 :   gfc_add_modify (&cond_block, val, then_val);
    1249                 :        963 :   tree then_b = gfc_finish_block (&cond_block);
    1250                 :            : 
    1251                 :        963 :   gfc_build_cond_assign (block, val, cond_val, then_b, else_val);
    1252                 :            : 
    1253                 :        963 :   return val;
    1254                 :            : }
    1255                 :            : 
    1256                 :            : void
    1257                 :      16741 : gfc_omp_finish_clause (tree c, gimple_seq *pre_p)
    1258                 :            : {
    1259                 :      16741 :   if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_MAP)
    1260                 :            :     return;
    1261                 :            : 
    1262                 :       4261 :   tree decl = OMP_CLAUSE_DECL (c);
    1263                 :            : 
    1264                 :            :   /* Assumed-size arrays can't be mapped implicitly, they have to be
    1265                 :            :      mapped explicitly using array sections.  */
    1266                 :       4261 :   if (TREE_CODE (decl) == PARM_DECL
    1267                 :        802 :       && GFC_ARRAY_TYPE_P (TREE_TYPE (decl))
    1268                 :        338 :       && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (decl)) == GFC_ARRAY_UNKNOWN
    1269                 :       4599 :       && GFC_TYPE_ARRAY_UBOUND (TREE_TYPE (decl),
    1270                 :            :                                 GFC_TYPE_ARRAY_RANK (TREE_TYPE (decl)) - 1)
    1271                 :            :          == NULL)
    1272                 :            :     {
    1273                 :          1 :       error_at (OMP_CLAUSE_LOCATION (c),
    1274                 :            :                 "implicit mapping of assumed size array %qD", decl);
    1275                 :          1 :       return;
    1276                 :            :     }
    1277                 :            : 
    1278                 :       4260 :   tree c2 = NULL_TREE, c3 = NULL_TREE, c4 = NULL_TREE;
    1279                 :       4260 :   tree present = gfc_omp_check_optional_argument (decl, true);
    1280                 :       4260 :   if (POINTER_TYPE_P (TREE_TYPE (decl)))
    1281                 :            :     {
    1282                 :        919 :       if (!gfc_omp_privatize_by_reference (decl)
    1283                 :         12 :           && !GFC_DECL_GET_SCALAR_POINTER (decl)
    1284                 :          0 :           && !GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
    1285                 :          0 :           && !GFC_DECL_CRAY_POINTEE (decl)
    1286                 :        919 :           && !GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (decl))))
    1287                 :            :         return;
    1288                 :        919 :       tree orig_decl = decl;
    1289                 :            : 
    1290                 :            :       /* For nonallocatable, nonpointer arrays, a temporary variable is
    1291                 :            :          generated, but this one is only defined if the variable is present;
    1292                 :            :          hence, we now set it to NULL to avoid accessing undefined variables.
    1293                 :            :          We cannot use a temporary variable here as otherwise the replacement
    1294                 :            :          of the variables in omp-low.c will not work.  */
    1295                 :       1147 :       if (present && GFC_ARRAY_TYPE_P (TREE_TYPE (decl)))
    1296                 :            :         {
    1297                 :         78 :           tree tmp = fold_build2_loc (input_location, MODIFY_EXPR,
    1298                 :            :                                       void_type_node, decl, null_pointer_node);
    1299                 :         78 :           tree cond = fold_build1_loc (input_location, TRUTH_NOT_EXPR,
    1300                 :            :                                        boolean_type_node, present);
    1301                 :         78 :           tmp = build3_loc (input_location, COND_EXPR, void_type_node,
    1302                 :            :                             cond, tmp, NULL_TREE);
    1303                 :         78 :           gimplify_and_add (tmp, pre_p);
    1304                 :            :         }
    1305                 :            : 
    1306                 :        919 :       c4 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP);
    1307                 :        919 :       OMP_CLAUSE_SET_MAP_KIND (c4, GOMP_MAP_POINTER);
    1308                 :        919 :       OMP_CLAUSE_DECL (c4) = decl;
    1309                 :        919 :       OMP_CLAUSE_SIZE (c4) = size_int (0);
    1310                 :        919 :       decl = build_fold_indirect_ref (decl);
    1311                 :        919 :       if (present
    1312                 :       1147 :           && (GFC_DECL_GET_SCALAR_POINTER (orig_decl)
    1313                 :        216 :               || GFC_DECL_GET_SCALAR_ALLOCATABLE (orig_decl)))
    1314                 :            :         {
    1315                 :         12 :           c2 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
    1316                 :         12 :           OMP_CLAUSE_SET_MAP_KIND (c2, GOMP_MAP_POINTER);
    1317                 :         12 :           OMP_CLAUSE_DECL (c2) = decl;
    1318                 :         12 :           OMP_CLAUSE_SIZE (c2) = size_int (0);
    1319                 :            : 
    1320                 :         12 :           stmtblock_t block;
    1321                 :         12 :           gfc_start_block (&block);
    1322                 :         12 :           tree ptr = decl;
    1323                 :         12 :           ptr = gfc_build_cond_assign_expr (&block, present, decl,
    1324                 :            :                                             null_pointer_node);
    1325                 :         12 :           gimplify_and_add (gfc_finish_block (&block), pre_p);
    1326                 :         12 :           ptr = build_fold_indirect_ref (ptr);
    1327                 :         12 :           OMP_CLAUSE_DECL (c) = ptr;
    1328                 :         12 :           OMP_CLAUSE_SIZE (c) = TYPE_SIZE_UNIT (TREE_TYPE (ptr));
    1329                 :            :         }
    1330                 :            :       else
    1331                 :            :         {
    1332                 :        907 :           OMP_CLAUSE_DECL (c) = decl;
    1333                 :        907 :           OMP_CLAUSE_SIZE (c) = NULL_TREE;
    1334                 :            :         }
    1335                 :        919 :       if (TREE_CODE (TREE_TYPE (orig_decl)) == REFERENCE_TYPE
    1336                 :       1221 :           && (GFC_DECL_GET_SCALAR_POINTER (orig_decl)
    1337                 :        290 :               || GFC_DECL_GET_SCALAR_ALLOCATABLE (orig_decl)))
    1338                 :            :         {
    1339                 :         12 :           c3 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP);
    1340                 :         12 :           OMP_CLAUSE_SET_MAP_KIND (c3, GOMP_MAP_POINTER);
    1341                 :         12 :           OMP_CLAUSE_DECL (c3) = unshare_expr (decl);
    1342                 :         12 :           OMP_CLAUSE_SIZE (c3) = size_int (0);
    1343                 :         12 :           decl = build_fold_indirect_ref (decl);
    1344                 :         12 :           OMP_CLAUSE_DECL (c) = decl;
    1345                 :            :         }
    1346                 :            :     }
    1347                 :       4260 :   if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
    1348                 :            :     {
    1349                 :       1301 :       stmtblock_t block;
    1350                 :       1301 :       gfc_start_block (&block);
    1351                 :       1301 :       tree type = TREE_TYPE (decl);
    1352                 :       1301 :       tree ptr = gfc_conv_descriptor_data_get (decl);
    1353                 :            : 
    1354                 :       1301 :       if (present)
    1355                 :         78 :         ptr = gfc_build_cond_assign_expr (&block, present, ptr,
    1356                 :            :                                           null_pointer_node);
    1357                 :       1301 :       ptr = fold_convert (build_pointer_type (char_type_node), ptr);
    1358                 :       1301 :       ptr = build_fold_indirect_ref (ptr);
    1359                 :       1301 :       OMP_CLAUSE_DECL (c) = ptr;
    1360                 :       1301 :       c2 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
    1361                 :       1301 :       OMP_CLAUSE_SET_MAP_KIND (c2, GOMP_MAP_TO_PSET);
    1362                 :       1301 :       if (present)
    1363                 :            :         {
    1364                 :         78 :           ptr = create_tmp_var (TREE_TYPE (TREE_OPERAND (decl, 0)));
    1365                 :         78 :           gfc_add_modify (&block, ptr, TREE_OPERAND (decl, 0));
    1366                 :            : 
    1367                 :         78 :           OMP_CLAUSE_DECL (c2) = build_fold_indirect_ref (ptr);
    1368                 :            :         }
    1369                 :            :       else
    1370                 :       1223 :         OMP_CLAUSE_DECL (c2) = decl;
    1371                 :       1301 :       OMP_CLAUSE_SIZE (c2) = TYPE_SIZE_UNIT (type);
    1372                 :       1301 :       c3 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP);
    1373                 :       1301 :       OMP_CLAUSE_SET_MAP_KIND (c3, GOMP_MAP_POINTER);
    1374                 :       1301 :       if (present)
    1375                 :            :         {
    1376                 :         78 :           ptr = gfc_conv_descriptor_data_get (decl);
    1377                 :         78 :           ptr = gfc_build_addr_expr (NULL, ptr);
    1378                 :         78 :           ptr = gfc_build_cond_assign_expr (&block, present,
    1379                 :            :                                             ptr, null_pointer_node);
    1380                 :         78 :           ptr = build_fold_indirect_ref (ptr);
    1381                 :         78 :           OMP_CLAUSE_DECL (c3) = ptr;
    1382                 :            :         }
    1383                 :            :       else
    1384                 :       1223 :         OMP_CLAUSE_DECL (c3) = gfc_conv_descriptor_data_get (decl);
    1385                 :       1301 :       OMP_CLAUSE_SIZE (c3) = size_int (0);
    1386                 :       1301 :       tree size = create_tmp_var (gfc_array_index_type);
    1387                 :       1301 :       tree elemsz = TYPE_SIZE_UNIT (gfc_get_element_type (type));
    1388                 :       1301 :       elemsz = fold_convert (gfc_array_index_type, elemsz);
    1389                 :       1301 :       if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER
    1390                 :       1301 :           || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT)
    1391                 :            :         {
    1392                 :        102 :           stmtblock_t cond_block;
    1393                 :        102 :           tree tem, then_b, else_b, zero, cond;
    1394                 :            : 
    1395                 :        102 :           gfc_init_block (&cond_block);
    1396                 :        102 :           tem = gfc_full_array_size (&cond_block, decl,
    1397                 :        102 :                                      GFC_TYPE_ARRAY_RANK (type));
    1398                 :        102 :           gfc_add_modify (&cond_block, size, tem);
    1399                 :        102 :           gfc_add_modify (&cond_block, size,
    1400                 :            :                           fold_build2 (MULT_EXPR, gfc_array_index_type,
    1401                 :            :                                        size, elemsz));
    1402                 :        102 :           then_b = gfc_finish_block (&cond_block);
    1403                 :        102 :           gfc_init_block (&cond_block);
    1404                 :        102 :           zero = build_int_cst (gfc_array_index_type, 0);
    1405                 :        102 :           gfc_add_modify (&cond_block, size, zero);
    1406                 :        102 :           else_b = gfc_finish_block (&cond_block);
    1407                 :        102 :           tem = gfc_conv_descriptor_data_get (decl);
    1408                 :        102 :           tem = fold_convert (pvoid_type_node, tem);
    1409                 :        102 :           cond = fold_build2_loc (input_location, NE_EXPR,
    1410                 :            :                                   boolean_type_node, tem, null_pointer_node);
    1411                 :        102 :           if (present)
    1412                 :            :             {
    1413                 :         12 :               cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
    1414                 :            :                                       boolean_type_node, present, cond);
    1415                 :            :             }
    1416                 :        204 :           gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR,
    1417                 :            :                                                      void_type_node, cond,
    1418                 :            :                                                      then_b, else_b));
    1419                 :            :         }
    1420                 :       1199 :       else if (present)
    1421                 :            :         {
    1422                 :         66 :           stmtblock_t cond_block;
    1423                 :         66 :           tree then_b;
    1424                 :            : 
    1425                 :         66 :           gfc_init_block (&cond_block);
    1426                 :        132 :           gfc_add_modify (&cond_block, size,
    1427                 :            :                           gfc_full_array_size (&cond_block, decl,
    1428                 :         66 :                                                GFC_TYPE_ARRAY_RANK (type)));
    1429                 :         66 :           gfc_add_modify (&cond_block, size,
    1430                 :            :                           fold_build2 (MULT_EXPR, gfc_array_index_type,
    1431                 :            :                                        size, elemsz));
    1432                 :         66 :           then_b = gfc_finish_block (&cond_block);
    1433                 :            : 
    1434                 :         66 :           gfc_build_cond_assign (&block, size, present, then_b,
    1435                 :         66 :                                  build_int_cst (gfc_array_index_type, 0));
    1436                 :            :         }
    1437                 :            :       else
    1438                 :            :         {
    1439                 :       1133 :           gfc_add_modify (&block, size,
    1440                 :            :                           gfc_full_array_size (&block, decl,
    1441                 :       1133 :                                                GFC_TYPE_ARRAY_RANK (type)));
    1442                 :       1133 :           gfc_add_modify (&block, size,
    1443                 :            :                           fold_build2 (MULT_EXPR, gfc_array_index_type,
    1444                 :            :                                        size, elemsz));
    1445                 :            :         }
    1446                 :       1301 :       OMP_CLAUSE_SIZE (c) = size;
    1447                 :       1301 :       tree stmt = gfc_finish_block (&block);
    1448                 :       1301 :       gimplify_and_add (stmt, pre_p);
    1449                 :            :     }
    1450                 :       4260 :   tree last = c;
    1451                 :       4260 :   if (OMP_CLAUSE_SIZE (c) == NULL_TREE)
    1452                 :        815 :     OMP_CLAUSE_SIZE (c)
    1453                 :       1790 :       = DECL_P (decl) ? DECL_SIZE_UNIT (decl)
    1454                 :        655 :                       : TYPE_SIZE_UNIT (TREE_TYPE (decl));
    1455                 :       4260 :   if (c2)
    1456                 :            :     {
    1457                 :       1313 :       OMP_CLAUSE_CHAIN (c2) = OMP_CLAUSE_CHAIN (last);
    1458                 :       1313 :       OMP_CLAUSE_CHAIN (last) = c2;
    1459                 :       1313 :       last = c2;
    1460                 :            :     }
    1461                 :       4260 :   if (c3)
    1462                 :            :     {
    1463                 :       1313 :       OMP_CLAUSE_CHAIN (c3) = OMP_CLAUSE_CHAIN (last);
    1464                 :       1313 :       OMP_CLAUSE_CHAIN (last) = c3;
    1465                 :       1313 :       last = c3;
    1466                 :            :     }
    1467                 :       4260 :   if (c4)
    1468                 :            :     {
    1469                 :        919 :       OMP_CLAUSE_CHAIN (c4) = OMP_CLAUSE_CHAIN (last);
    1470                 :        919 :       OMP_CLAUSE_CHAIN (last) = c4;
    1471                 :            :     }
    1472                 :            : }
    1473                 :            : 
    1474                 :            : 
    1475                 :            : /* Return true if DECL is a scalar variable (for the purpose of
    1476                 :            :    implicit firstprivatization).  */
    1477                 :            : 
    1478                 :            : bool
    1479                 :       1439 : gfc_omp_scalar_p (tree decl)
    1480                 :            : {
    1481                 :       1439 :   tree type = TREE_TYPE (decl);
    1482                 :       1439 :   if (TREE_CODE (type) == REFERENCE_TYPE)
    1483                 :        553 :     type = TREE_TYPE (type);
    1484                 :       1439 :   if (TREE_CODE (type) == POINTER_TYPE)
    1485                 :            :     {
    1486                 :          0 :       if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
    1487                 :          0 :           || GFC_DECL_GET_SCALAR_POINTER (decl))
    1488                 :          0 :         type = TREE_TYPE (type);
    1489                 :          0 :       if (GFC_ARRAY_TYPE_P (type)
    1490                 :          0 :           || GFC_CLASS_TYPE_P (type))
    1491                 :            :         return false;
    1492                 :            :     }
    1493                 :       1439 :   if ((TREE_CODE (type) == ARRAY_TYPE || TREE_CODE (type) == INTEGER_TYPE)
    1494                 :       2601 :       && TYPE_STRING_FLAG (type))
    1495                 :            :     return false;
    1496                 :       1439 :   if (INTEGRAL_TYPE_P (type)
    1497                 :       1439 :       || SCALAR_FLOAT_TYPE_P (type)
    1498                 :       1439 :       || COMPLEX_FLOAT_TYPE_P (type))
    1499                 :       1250 :     return true;
    1500                 :            :   return false;
    1501                 :            : }
    1502                 :            : 
    1503                 :            : 
    1504                 :            : /* Return true if DECL's DECL_VALUE_EXPR (if any) should be
    1505                 :            :    disregarded in OpenMP construct, because it is going to be
    1506                 :            :    remapped during OpenMP lowering.  SHARED is true if DECL
    1507                 :            :    is going to be shared, false if it is going to be privatized.  */
    1508                 :            : 
    1509                 :            : bool
    1510                 :    1250320 : gfc_omp_disregard_value_expr (tree decl, bool shared)
    1511                 :            : {
    1512                 :    1250320 :   if (GFC_DECL_COMMON_OR_EQUIV (decl)
    1513                 :    1253780 :       && DECL_HAS_VALUE_EXPR_P (decl))
    1514                 :            :     {
    1515                 :       3055 :       tree value = DECL_VALUE_EXPR (decl);
    1516                 :            : 
    1517                 :       3055 :       if (TREE_CODE (value) == COMPONENT_REF
    1518                 :       3055 :           && VAR_P (TREE_OPERAND (value, 0))
    1519                 :       6110 :           && GFC_DECL_COMMON_OR_EQUIV (TREE_OPERAND (value, 0)))
    1520                 :            :         {
    1521                 :            :           /* If variable in COMMON or EQUIVALENCE is privatized, return
    1522                 :            :              true, as just that variable is supposed to be privatized,
    1523                 :            :              not the whole COMMON or whole EQUIVALENCE.
    1524                 :            :              For shared variables in COMMON or EQUIVALENCE, let them be
    1525                 :            :              gimplified to DECL_VALUE_EXPR, so that for multiple shared vars
    1526                 :            :              from the same COMMON or EQUIVALENCE just one sharing of the
    1527                 :            :              whole COMMON or EQUIVALENCE is enough.  */
    1528                 :       3055 :           return ! shared;
    1529                 :            :         }
    1530                 :            :     }
    1531                 :            : 
    1532                 :    1247840 :   if (GFC_DECL_RESULT (decl) && DECL_HAS_VALUE_EXPR_P (decl))
    1533                 :        374 :     return ! shared;
    1534                 :            : 
    1535                 :            :   return false;
    1536                 :            : }
    1537                 :            : 
    1538                 :            : /* Return true if DECL that is shared iff SHARED is true should
    1539                 :            :    be put into OMP_CLAUSE_PRIVATE with OMP_CLAUSE_PRIVATE_DEBUG
    1540                 :            :    flag set.  */
    1541                 :            : 
    1542                 :            : bool
    1543                 :      24408 : gfc_omp_private_debug_clause (tree decl, bool shared)
    1544                 :            : {
    1545                 :      24408 :   if (GFC_DECL_CRAY_POINTEE (decl))
    1546                 :            :     return true;
    1547                 :            : 
    1548                 :      24372 :   if (GFC_DECL_COMMON_OR_EQUIV (decl)
    1549                 :      24743 :       && DECL_HAS_VALUE_EXPR_P (decl))
    1550                 :            :     {
    1551                 :        325 :       tree value = DECL_VALUE_EXPR (decl);
    1552                 :            : 
    1553                 :        325 :       if (TREE_CODE (value) == COMPONENT_REF
    1554                 :        325 :           && VAR_P (TREE_OPERAND (value, 0))
    1555                 :        650 :           && GFC_DECL_COMMON_OR_EQUIV (TREE_OPERAND (value, 0)))
    1556                 :        325 :         return shared;
    1557                 :            :     }
    1558                 :            : 
    1559                 :            :   return false;
    1560                 :            : }
    1561                 :            : 
    1562                 :            : /* Register language specific type size variables as potentially OpenMP
    1563                 :            :    firstprivate variables.  */
    1564                 :            : 
    1565                 :            : void
    1566                 :      15955 : gfc_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *ctx, tree type)
    1567                 :            : {
    1568                 :      15955 :   if (GFC_ARRAY_TYPE_P (type) || GFC_DESCRIPTOR_TYPE_P (type))
    1569                 :            :     {
    1570                 :       3132 :       int r;
    1571                 :            : 
    1572                 :       3132 :       gcc_assert (TYPE_LANG_SPECIFIC (type) != NULL);
    1573                 :       7393 :       for (r = 0; r < GFC_TYPE_ARRAY_RANK (type); r++)
    1574                 :            :         {
    1575                 :       4261 :           omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_LBOUND (type, r));
    1576                 :       4261 :           omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_UBOUND (type, r));
    1577                 :       4261 :           omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_STRIDE (type, r));
    1578                 :            :         }
    1579                 :       3132 :       omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_SIZE (type));
    1580                 :       3132 :       omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_OFFSET (type));
    1581                 :            :     }
    1582                 :      15955 : }
    1583                 :            : 
    1584                 :            : 
    1585                 :            : static inline tree
    1586                 :      51519 : gfc_trans_add_clause (tree node, tree tail)
    1587                 :            : {
    1588                 :      51519 :   OMP_CLAUSE_CHAIN (node) = tail;
    1589                 :      51519 :   return node;
    1590                 :            : }
    1591                 :            : 
    1592                 :            : static tree
    1593                 :      29689 : gfc_trans_omp_variable (gfc_symbol *sym, bool declare_simd)
    1594                 :            : {
    1595                 :      29689 :   if (declare_simd)
    1596                 :            :     {
    1597                 :        161 :       int cnt = 0;
    1598                 :        161 :       gfc_symbol *proc_sym;
    1599                 :        161 :       gfc_formal_arglist *f;
    1600                 :            : 
    1601                 :        161 :       gcc_assert (sym->attr.dummy);
    1602                 :        161 :       proc_sym = sym->ns->proc_name;
    1603                 :        161 :       if (proc_sym->attr.entry_master)
    1604                 :          0 :         ++cnt;
    1605                 :        161 :       if (gfc_return_by_reference (proc_sym))
    1606                 :            :         {
    1607                 :          0 :           ++cnt;
    1608                 :          0 :           if (proc_sym->ts.type == BT_CHARACTER)
    1609                 :          0 :             ++cnt;
    1610                 :            :         }
    1611                 :        294 :       for (f = gfc_sym_get_dummy_args (proc_sym); f; f = f->next)
    1612                 :        294 :         if (f->sym == sym)
    1613                 :            :           break;
    1614                 :        133 :         else if (f->sym)
    1615                 :        133 :           ++cnt;
    1616                 :        161 :       gcc_assert (f);
    1617                 :        161 :       return build_int_cst (integer_type_node, cnt);
    1618                 :            :     }
    1619                 :            : 
    1620                 :      29528 :   tree t = gfc_get_symbol_decl (sym);
    1621                 :      29528 :   tree parent_decl;
    1622                 :      29528 :   int parent_flag;
    1623                 :      29528 :   bool return_value;
    1624                 :      29528 :   bool alternate_entry;
    1625                 :      29528 :   bool entry_master;
    1626                 :            : 
    1627                 :      29528 :   return_value = sym->attr.function && sym->result == sym;
    1628                 :        133 :   alternate_entry = sym->attr.function && sym->attr.entry
    1629                 :      29562 :                     && sym->result == sym;
    1630                 :      59056 :   entry_master = sym->attr.result
    1631                 :        106 :                  && sym->ns->proc_name->attr.entry_master
    1632                 :      29540 :                  && !gfc_return_by_reference (sym->ns->proc_name);
    1633                 :      59056 :   parent_decl = current_function_decl
    1634                 :      29528 :                 ? DECL_CONTEXT (current_function_decl) : NULL_TREE;
    1635                 :            : 
    1636                 :      29528 :   if ((t == parent_decl && return_value)
    1637                 :      29521 :        || (sym->ns && sym->ns->proc_name
    1638                 :      29521 :            && sym->ns->proc_name->backend_decl == parent_decl
    1639                 :        587 :            && (alternate_entry || entry_master)))
    1640                 :            :     parent_flag = 1;
    1641                 :            :   else
    1642                 :      29519 :     parent_flag = 0;
    1643                 :            : 
    1644                 :            :   /* Special case for assigning the return value of a function.
    1645                 :            :      Self recursive functions must have an explicit return value.  */
    1646                 :      29528 :   if (return_value && (t == current_function_decl || parent_flag))
    1647                 :         81 :     t = gfc_get_fake_result_decl (sym, parent_flag);
    1648                 :            : 
    1649                 :            :   /* Similarly for alternate entry points.  */
    1650                 :      29447 :   else if (alternate_entry
    1651                 :         32 :            && (sym->ns->proc_name->backend_decl == current_function_decl
    1652                 :          0 :                || parent_flag))
    1653                 :            :     {
    1654                 :         32 :       gfc_entry_list *el = NULL;
    1655                 :            : 
    1656                 :         51 :       for (el = sym->ns->entries; el; el = el->next)
    1657                 :         51 :         if (sym == el->sym)
    1658                 :            :           {
    1659                 :         32 :             t = gfc_get_fake_result_decl (sym, parent_flag);
    1660                 :         32 :             break;
    1661                 :            :           }
    1662                 :            :     }
    1663                 :            : 
    1664                 :      29415 :   else if (entry_master
    1665                 :         12 :            && (sym->ns->proc_name->backend_decl == current_function_decl
    1666                 :          0 :                || parent_flag))
    1667                 :         12 :     t = gfc_get_fake_result_decl (sym, parent_flag);
    1668                 :            : 
    1669                 :            :   return t;
    1670                 :            : }
    1671                 :            : 
    1672                 :            : static tree
    1673                 :       7871 : gfc_trans_omp_variable_list (enum omp_clause_code code,
    1674                 :            :                              gfc_omp_namelist *namelist, tree list,
    1675                 :            :                              bool declare_simd)
    1676                 :            : {
    1677                 :      20015 :   for (; namelist != NULL; namelist = namelist->next)
    1678                 :      12144 :     if (namelist->sym->attr.referenced || declare_simd)
    1679                 :            :       {
    1680                 :      12144 :         tree t = gfc_trans_omp_variable (namelist->sym, declare_simd);
    1681                 :      12144 :         if (t != error_mark_node)
    1682                 :            :           {
    1683                 :      12144 :             tree node = build_omp_clause (input_location, code);
    1684                 :      12144 :             OMP_CLAUSE_DECL (node) = t;
    1685                 :      12144 :             list = gfc_trans_add_clause (node, list);
    1686                 :            :           }
    1687                 :            :       }
    1688                 :       7871 :   return list;
    1689                 :            : }
    1690                 :            : 
    1691                 :            : struct omp_udr_find_orig_data
    1692                 :            : {
    1693                 :            :   gfc_omp_udr *omp_udr;
    1694                 :            :   bool omp_orig_seen;
    1695                 :            : };
    1696                 :            : 
    1697                 :            : static int
    1698                 :        678 : omp_udr_find_orig (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
    1699                 :            :                    void *data)
    1700                 :            : {
    1701                 :        678 :   struct omp_udr_find_orig_data *cd = (struct omp_udr_find_orig_data *) data;
    1702                 :        678 :   if ((*e)->expr_type == EXPR_VARIABLE
    1703                 :        366 :       && (*e)->symtree->n.sym == cd->omp_udr->omp_orig)
    1704                 :         72 :     cd->omp_orig_seen = true;
    1705                 :            : 
    1706                 :        678 :   return 0;
    1707                 :            : }
    1708                 :            : 
    1709                 :            : static void
    1710                 :        659 : gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
    1711                 :            : {
    1712                 :        659 :   gfc_symbol *sym = n->sym;
    1713                 :        659 :   gfc_symtree *root1 = NULL, *root2 = NULL, *root3 = NULL, *root4 = NULL;
    1714                 :        659 :   gfc_symtree *symtree1, *symtree2, *symtree3, *symtree4 = NULL;
    1715                 :        659 :   gfc_symbol init_val_sym, outer_sym, intrinsic_sym;
    1716                 :        659 :   gfc_symbol omp_var_copy[4];
    1717                 :        659 :   gfc_expr *e1, *e2, *e3, *e4;
    1718                 :        659 :   gfc_ref *ref;
    1719                 :        659 :   tree decl, backend_decl, stmt, type, outer_decl;
    1720                 :        659 :   locus old_loc = gfc_current_locus;
    1721                 :        659 :   const char *iname;
    1722                 :        659 :   bool t;
    1723                 :        659 :   gfc_omp_udr *udr = n->udr ? n->udr->udr : NULL;
    1724                 :            : 
    1725                 :        659 :   decl = OMP_CLAUSE_DECL (c);
    1726                 :        659 :   gfc_current_locus = where;
    1727                 :        659 :   type = TREE_TYPE (decl);
    1728                 :        659 :   outer_decl = create_tmp_var_raw (type);
    1729                 :        659 :   if (TREE_CODE (decl) == PARM_DECL
    1730                 :         18 :       && TREE_CODE (type) == REFERENCE_TYPE
    1731                 :         12 :       && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (type))
    1732                 :        671 :       && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (type)) == GFC_ARRAY_ALLOCATABLE)
    1733                 :            :     {
    1734                 :         12 :       decl = build_fold_indirect_ref (decl);
    1735                 :         12 :       type = TREE_TYPE (type);
    1736                 :            :     }
    1737                 :            : 
    1738                 :            :   /* Create a fake symbol for init value.  */
    1739                 :        659 :   memset (&init_val_sym, 0, sizeof (init_val_sym));
    1740                 :        659 :   init_val_sym.ns = sym->ns;
    1741                 :        659 :   init_val_sym.name = sym->name;
    1742                 :        659 :   init_val_sym.ts = sym->ts;
    1743                 :        659 :   init_val_sym.attr.referenced = 1;
    1744                 :        659 :   init_val_sym.declared_at = where;
    1745                 :        659 :   init_val_sym.attr.flavor = FL_VARIABLE;
    1746                 :        659 :   if (OMP_CLAUSE_REDUCTION_CODE (c) != ERROR_MARK)
    1747                 :        259 :     backend_decl = omp_reduction_init (c, gfc_sym_type (&init_val_sym));
    1748                 :        400 :   else if (udr->initializer_ns)
    1749                 :            :     backend_decl = NULL;
    1750                 :            :   else
    1751                 :        130 :     switch (sym->ts.type)
    1752                 :            :       {
    1753                 :         15 :       case BT_LOGICAL:
    1754                 :         15 :       case BT_INTEGER:
    1755                 :         15 :       case BT_REAL:
    1756                 :         15 :       case BT_COMPLEX:
    1757                 :         15 :         backend_decl = build_zero_cst (gfc_sym_type (&init_val_sym));
    1758                 :         15 :         break;
    1759                 :            :       default:
    1760                 :            :         backend_decl = NULL_TREE;
    1761                 :            :         break;
    1762                 :            :       }
    1763                 :        659 :   init_val_sym.backend_decl = backend_decl;
    1764                 :            : 
    1765                 :            :   /* Create a fake symbol for the outer array reference.  */
    1766                 :        659 :   outer_sym = *sym;
    1767                 :        659 :   if (sym->as)
    1768                 :        402 :     outer_sym.as = gfc_copy_array_spec (sym->as);
    1769                 :        659 :   outer_sym.attr.dummy = 0;
    1770                 :        659 :   outer_sym.attr.result = 0;
    1771                 :        659 :   outer_sym.attr.flavor = FL_VARIABLE;
    1772                 :        659 :   outer_sym.backend_decl = outer_decl;
    1773                 :        659 :   if (decl != OMP_CLAUSE_DECL (c))
    1774                 :         12 :     outer_sym.backend_decl = build_fold_indirect_ref (outer_decl);
    1775                 :            : 
    1776                 :            :   /* Create fake symtrees for it.  */
    1777                 :        659 :   symtree1 = gfc_new_symtree (&root1, sym->name);
    1778                 :        659 :   symtree1->n.sym = sym;
    1779                 :        659 :   gcc_assert (symtree1 == root1);
    1780                 :            : 
    1781                 :        659 :   symtree2 = gfc_new_symtree (&root2, sym->name);
    1782                 :        659 :   symtree2->n.sym = &init_val_sym;
    1783                 :        659 :   gcc_assert (symtree2 == root2);
    1784                 :            : 
    1785                 :        659 :   symtree3 = gfc_new_symtree (&root3, sym->name);
    1786                 :        659 :   symtree3->n.sym = &outer_sym;
    1787                 :        659 :   gcc_assert (symtree3 == root3);
    1788                 :            : 
    1789                 :        659 :   memset (omp_var_copy, 0, sizeof omp_var_copy);
    1790                 :        659 :   if (udr)
    1791                 :            :     {
    1792                 :        400 :       omp_var_copy[0] = *udr->omp_out;
    1793                 :        400 :       omp_var_copy[1] = *udr->omp_in;
    1794                 :        400 :       *udr->omp_out = outer_sym;
    1795                 :        400 :       *udr->omp_in = *sym;
    1796                 :        400 :       if (udr->initializer_ns)
    1797                 :            :         {
    1798                 :        270 :           omp_var_copy[2] = *udr->omp_priv;
    1799                 :        270 :           omp_var_copy[3] = *udr->omp_orig;
    1800                 :        270 :           *udr->omp_priv = *sym;
    1801                 :        270 :           *udr->omp_orig = outer_sym;
    1802                 :            :         }
    1803                 :            :     }
    1804                 :            : 
    1805                 :            :   /* Create expressions.  */
    1806                 :        659 :   e1 = gfc_get_expr ();
    1807                 :        659 :   e1->expr_type = EXPR_VARIABLE;
    1808                 :        659 :   e1->where = where;
    1809                 :        659 :   e1->symtree = symtree1;
    1810                 :        659 :   e1->ts = sym->ts;
    1811                 :        659 :   if (sym->attr.dimension)
    1812                 :            :     {
    1813                 :        402 :       e1->ref = ref = gfc_get_ref ();
    1814                 :        402 :       ref->type = REF_ARRAY;
    1815                 :        402 :       ref->u.ar.where = where;
    1816                 :        402 :       ref->u.ar.as = sym->as;
    1817                 :        402 :       ref->u.ar.type = AR_FULL;
    1818                 :        402 :       ref->u.ar.dimen = 0;
    1819                 :            :     }
    1820                 :        659 :   t = gfc_resolve_expr (e1);
    1821                 :        659 :   gcc_assert (t);
    1822                 :            : 
    1823                 :        659 :   e2 = NULL;
    1824                 :        659 :   if (backend_decl != NULL_TREE)
    1825                 :            :     {
    1826                 :        274 :       e2 = gfc_get_expr ();
    1827                 :        274 :       e2->expr_type = EXPR_VARIABLE;
    1828                 :        274 :       e2->where = where;
    1829                 :        274 :       e2->symtree = symtree2;
    1830                 :        274 :       e2->ts = sym->ts;
    1831                 :        274 :       t = gfc_resolve_expr (e2);
    1832                 :        274 :       gcc_assert (t);
    1833                 :            :     }
    1834                 :        385 :   else if (udr->initializer_ns == NULL)
    1835                 :            :     {
    1836                 :        115 :       gcc_assert (sym->ts.type == BT_DERIVED);
    1837                 :        115 :       e2 = gfc_default_initializer (&sym->ts);
    1838                 :        115 :       gcc_assert (e2);
    1839                 :        115 :       t = gfc_resolve_expr (e2);
    1840                 :        115 :       gcc_assert (t);
    1841                 :            :     }
    1842                 :        270 :   else if (n->udr->initializer->op == EXEC_ASSIGN)
    1843                 :            :     {
    1844                 :        204 :       e2 = gfc_copy_expr (n->udr->initializer->expr2);
    1845                 :        204 :       t = gfc_resolve_expr (e2);
    1846                 :        204 :       gcc_assert (t);
    1847                 :            :     }
    1848                 :        659 :   if (udr && udr->initializer_ns)
    1849                 :            :     {
    1850                 :        270 :       struct omp_udr_find_orig_data cd;
    1851                 :        270 :       cd.omp_udr = udr;
    1852                 :        270 :       cd.omp_orig_seen = false;
    1853                 :        270 :       gfc_code_walker (&n->udr->initializer,
    1854                 :            :                        gfc_dummy_code_callback, omp_udr_find_orig, &cd);
    1855                 :        270 :       if (cd.omp_orig_seen)
    1856                 :         72 :         OMP_CLAUSE_REDUCTION_OMP_ORIG_REF (c) = 1;
    1857                 :            :     }
    1858                 :            : 
    1859                 :        659 :   e3 = gfc_copy_expr (e1);
    1860                 :        659 :   e3->symtree = symtree3;
    1861                 :        659 :   t = gfc_resolve_expr (e3);
    1862                 :        659 :   gcc_assert (t);
    1863                 :            : 
    1864                 :        659 :   iname = NULL;
    1865                 :        659 :   e4 = NULL;
    1866                 :        659 :   switch (OMP_CLAUSE_REDUCTION_CODE (c))
    1867                 :            :     {
    1868                 :        139 :     case PLUS_EXPR:
    1869                 :        139 :     case MINUS_EXPR:
    1870                 :        139 :       e4 = gfc_add (e3, e1);
    1871                 :        139 :       break;
    1872                 :         24 :     case MULT_EXPR:
    1873                 :         24 :       e4 = gfc_multiply (e3, e1);
    1874                 :         24 :       break;
    1875                 :          6 :     case TRUTH_ANDIF_EXPR:
    1876                 :          6 :       e4 = gfc_and (e3, e1);
    1877                 :          6 :       break;
    1878                 :          6 :     case TRUTH_ORIF_EXPR:
    1879                 :          6 :       e4 = gfc_or (e3, e1);
    1880                 :          6 :       break;
    1881                 :          6 :     case EQ_EXPR:
    1882                 :          6 :       e4 = gfc_eqv (e3, e1);
    1883                 :          6 :       break;
    1884                 :          6 :     case NE_EXPR:
    1885                 :          6 :       e4 = gfc_neqv (e3, e1);
    1886                 :          6 :       break;
    1887                 :            :     case MIN_EXPR:
    1888                 :            :       iname = "min";
    1889                 :            :       break;
    1890                 :         24 :     case MAX_EXPR:
    1891                 :         24 :       iname = "max";
    1892                 :         24 :       break;
    1893                 :          6 :     case BIT_AND_EXPR:
    1894                 :          6 :       iname = "iand";
    1895                 :          6 :       break;
    1896                 :          6 :     case BIT_IOR_EXPR:
    1897                 :          6 :       iname = "ior";
    1898                 :          6 :       break;
    1899                 :          6 :     case BIT_XOR_EXPR:
    1900                 :          6 :       iname = "ieor";
    1901                 :          6 :       break;
    1902                 :        400 :     case ERROR_MARK:
    1903                 :        400 :       if (n->udr->combiner->op == EXEC_ASSIGN)
    1904                 :            :         {
    1905                 :        334 :           gfc_free_expr (e3);
    1906                 :        334 :           e3 = gfc_copy_expr (n->udr->combiner->expr1);
    1907                 :        334 :           e4 = gfc_copy_expr (n->udr->combiner->expr2);
    1908                 :        334 :           t = gfc_resolve_expr (e3);
    1909                 :        334 :           gcc_assert (t);
    1910                 :        334 :           t = gfc_resolve_expr (e4);
    1911                 :        334 :           gcc_assert (t);
    1912                 :            :         }
    1913                 :            :       break;
    1914                 :          0 :     default:
    1915                 :          0 :       gcc_unreachable ();
    1916                 :            :     }
    1917                 :        659 :   if (iname != NULL)
    1918                 :            :     {
    1919                 :         72 :       memset (&intrinsic_sym, 0, sizeof (intrinsic_sym));
    1920                 :         72 :       intrinsic_sym.ns = sym->ns;
    1921                 :         72 :       intrinsic_sym.name = iname;
    1922                 :         72 :       intrinsic_sym.ts = sym->ts;
    1923                 :         72 :       intrinsic_sym.attr.referenced = 1;
    1924                 :         72 :       intrinsic_sym.attr.intrinsic = 1;
    1925                 :         72 :       intrinsic_sym.attr.function = 1;
    1926                 :         72 :       intrinsic_sym.attr.implicit_type = 1;
    1927                 :         72 :       intrinsic_sym.result = &intrinsic_sym;
    1928                 :         72 :       intrinsic_sym.declared_at = where;
    1929                 :            : 
    1930                 :         72 :       symtree4 = gfc_new_symtree (&root4, iname);
    1931                 :         72 :       symtree4->n.sym = &intrinsic_sym;
    1932                 :         72 :       gcc_assert (symtree4 == root4);
    1933                 :            : 
    1934                 :         72 :       e4 = gfc_get_expr ();
    1935                 :         72 :       e4->expr_type = EXPR_FUNCTION;
    1936                 :         72 :       e4->where = where;
    1937                 :         72 :       e4->symtree = symtree4;
    1938                 :         72 :       e4->value.function.actual = gfc_get_actual_arglist ();
    1939                 :         72 :       e4->value.function.actual->expr = e3;
    1940                 :         72 :       e4->value.function.actual->next = gfc_get_actual_arglist ();
    1941                 :         72 :       e4->value.function.actual->next->expr = e1;
    1942                 :            :     }
    1943                 :        659 :   if (OMP_CLAUSE_REDUCTION_CODE (c) != ERROR_MARK)
    1944                 :            :     {
    1945                 :            :       /* e1 and e3 have been stored as arguments of e4, avoid sharing.  */
    1946                 :        259 :       e1 = gfc_copy_expr (e1);
    1947                 :        259 :       e3 = gfc_copy_expr (e3);
    1948                 :        259 :       t = gfc_resolve_expr (e4);
    1949                 :        259 :       gcc_assert (t);
    1950                 :            :     }
    1951                 :            : 
    1952                 :            :   /* Create the init statement list.  */
    1953                 :        659 :   pushlevel ();
    1954                 :        659 :   if (e2)
    1955                 :        593 :     stmt = gfc_trans_assignment (e1, e2, false, false);
    1956                 :            :   else
    1957                 :         66 :     stmt = gfc_trans_call (n->udr->initializer, false,
    1958                 :            :                            NULL_TREE, NULL_TREE, false);
    1959                 :        659 :   if (TREE_CODE (stmt) != BIND_EXPR)
    1960                 :        154 :     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
    1961                 :            :   else
    1962                 :        505 :     poplevel (0, 0);
    1963                 :        659 :   OMP_CLAUSE_REDUCTION_INIT (c) = stmt;
    1964                 :            : 
    1965                 :            :   /* Create the merge statement list.  */
    1966                 :        659 :   pushlevel ();
    1967                 :        659 :   if (e4)
    1968                 :        593 :     stmt = gfc_trans_assignment (e3, e4, false, true);
    1969                 :            :   else
    1970                 :         66 :     stmt = gfc_trans_call (n->udr->combiner, false,
    1971                 :            :                            NULL_TREE, NULL_TREE, false);
    1972                 :        659 :   if (TREE_CODE (stmt) != BIND_EXPR)
    1973                 :        233 :     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
    1974                 :            :   else
    1975                 :        426 :     poplevel (0, 0);
    1976                 :        659 :   OMP_CLAUSE_REDUCTION_MERGE (c) = stmt;
    1977                 :            : 
    1978                 :            :   /* And stick the placeholder VAR_DECL into the clause as well.  */
    1979                 :        659 :   OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) = outer_decl;
    1980                 :            : 
    1981                 :        659 :   gfc_current_locus = old_loc;
    1982                 :            : 
    1983                 :        659 :   gfc_free_expr (e1);
    1984                 :        659 :   if (e2)
    1985                 :        593 :     gfc_free_expr (e2);
    1986                 :        659 :   gfc_free_expr (e3);
    1987                 :        659 :   if (e4)
    1988                 :        593 :     gfc_free_expr (e4);
    1989                 :        659 :   free (symtree1);
    1990                 :        659 :   free (symtree2);
    1991                 :        659 :   free (symtree3);
    1992                 :        659 :   free (symtree4);
    1993                 :        659 :   if (outer_sym.as)
    1994                 :        402 :     gfc_free_array_spec (outer_sym.as);
    1995                 :            : 
    1996                 :        659 :   if (udr)
    1997                 :            :     {
    1998                 :        400 :       *udr->omp_out = omp_var_copy[0];
    1999                 :        400 :       *udr->omp_in = omp_var_copy[1];
    2000                 :        400 :       if (udr->initializer_ns)
    2001                 :            :         {
    2002                 :        270 :           *udr->omp_priv = omp_var_copy[2];
    2003                 :        270 :           *udr->omp_orig = omp_var_copy[3];
    2004                 :            :         }
    2005                 :            :     }
    2006                 :        659 : }
    2007                 :            : 
    2008                 :            : static tree
    2009                 :       2878 : gfc_trans_omp_reduction_list (gfc_omp_namelist *namelist, tree list,
    2010                 :            :                               locus where, bool mark_addressable)
    2011                 :            : {
    2012                 :       6615 :   for (; namelist != NULL; namelist = namelist->next)
    2013                 :       3737 :     if (namelist->sym->attr.referenced)
    2014                 :            :       {
    2015                 :       3737 :         tree t = gfc_trans_omp_variable (namelist->sym, false);
    2016                 :       3737 :         if (t != error_mark_node)
    2017                 :            :           {
    2018                 :       3737 :             tree node = build_omp_clause (gfc_get_location (&namelist->where),
    2019                 :            :                                           OMP_CLAUSE_REDUCTION);
    2020                 :       3737 :             OMP_CLAUSE_DECL (node) = t;
    2021                 :       3737 :             if (mark_addressable)
    2022                 :         37 :               TREE_ADDRESSABLE (t) = 1;
    2023                 :       3737 :             switch (namelist->u.reduction_op)
    2024                 :            :               {
    2025                 :       1484 :               case OMP_REDUCTION_PLUS:
    2026                 :       1484 :                 OMP_CLAUSE_REDUCTION_CODE (node) = PLUS_EXPR;
    2027                 :       1484 :                 break;
    2028                 :        113 :               case OMP_REDUCTION_MINUS:
    2029                 :        113 :                 OMP_CLAUSE_REDUCTION_CODE (node) = MINUS_EXPR;
    2030                 :        113 :                 break;
    2031                 :        172 :               case OMP_REDUCTION_TIMES:
    2032                 :        172 :                 OMP_CLAUSE_REDUCTION_CODE (node) = MULT_EXPR;
    2033                 :        172 :                 break;
    2034                 :         90 :               case OMP_REDUCTION_AND:
    2035                 :         90 :                 OMP_CLAUSE_REDUCTION_CODE (node) = TRUTH_ANDIF_EXPR;
    2036                 :         90 :                 break;
    2037                 :        783 :               case OMP_REDUCTION_OR:
    2038                 :        783 :                 OMP_CLAUSE_REDUCTION_CODE (node) = TRUTH_ORIF_EXPR;
    2039                 :        783 :                 break;
    2040                 :         84 :               case OMP_REDUCTION_EQV:
    2041                 :         84 :                 OMP_CLAUSE_REDUCTION_CODE (node) = EQ_EXPR;
    2042                 :         84 :                 break;
    2043                 :         84 :               case OMP_REDUCTION_NEQV:
    2044                 :         84 :                 OMP_CLAUSE_REDUCTION_CODE (node) = NE_EXPR;
    2045                 :         84 :                 break;
    2046                 :        209 :               case OMP_REDUCTION_MAX:
    2047                 :        209 :                 OMP_CLAUSE_REDUCTION_CODE (node) = MAX_EXPR;
    2048                 :        209 :                 break;
    2049                 :        199 :               case OMP_REDUCTION_MIN:
    2050                 :        199 :                 OMP_CLAUSE_REDUCTION_CODE (node) = MIN_EXPR;
    2051                 :        199 :                 break;
    2052                 :         36 :               case OMP_REDUCTION_IAND:
    2053                 :         36 :                 OMP_CLAUSE_REDUCTION_CODE (node) = BIT_AND_EXPR;
    2054                 :         36 :                 break;
    2055                 :         47 :               case OMP_REDUCTION_IOR:
    2056                 :         47 :                 OMP_CLAUSE_REDUCTION_CODE (node) = BIT_IOR_EXPR;
    2057                 :         47 :                 break;
    2058                 :         36 :               case OMP_REDUCTION_IEOR:
    2059                 :         36 :                 OMP_CLAUSE_REDUCTION_CODE (node) = BIT_XOR_EXPR;
    2060                 :         36 :                 break;
    2061                 :        400 :               case OMP_REDUCTION_USER:
    2062                 :        400 :                 OMP_CLAUSE_REDUCTION_CODE (node) = ERROR_MARK;
    2063                 :        400 :                 break;
    2064                 :          0 :               default:
    2065                 :          0 :                 gcc_unreachable ();
    2066                 :            :               }
    2067                 :       3737 :             if (namelist->sym->attr.dimension
    2068                 :       3737 :                 || namelist->u.reduction_op == OMP_REDUCTION_USER
    2069                 :       3091 :                 || namelist->sym->attr.allocatable)
    2070                 :        659 :               gfc_trans_omp_array_reduction_or_udr (node, namelist, where);
    2071                 :       3737 :             list = gfc_trans_add_clause (node, list);
    2072                 :            :           }
    2073                 :            :       }
    2074                 :       2878 :   return list;
    2075                 :            : }
    2076                 :            : 
    2077                 :            : static inline tree
    2078                 :       3082 : gfc_convert_expr_to_tree (stmtblock_t *block, gfc_expr *expr)
    2079                 :            : {
    2080                 :       3082 :   gfc_se se;
    2081                 :       3082 :   tree result;
    2082                 :            : 
    2083                 :       3082 :   gfc_init_se (&se, NULL );
    2084                 :       3082 :   gfc_conv_expr (&se, expr);
    2085                 :       3082 :   gfc_add_block_to_block (block, &se.pre);
    2086                 :       3082 :   result = gfc_evaluate_now (se.expr, block);
    2087                 :       3082 :   gfc_add_block_to_block (block, &se.post);
    2088                 :            : 
    2089                 :       3082 :   return result;
    2090                 :            : }
    2091                 :            : 
    2092                 :            : static vec<tree, va_heap, vl_embed> *doacross_steps;
    2093                 :            : 
    2094                 :            : 
    2095                 :            : /* Translate an array section or array element.  */
    2096                 :            : 
    2097                 :            : static void
    2098                 :       2605 : gfc_trans_omp_array_section (stmtblock_t *block, gfc_omp_namelist *n,
    2099                 :            :                              tree decl, bool element, gomp_map_kind ptr_kind,
    2100                 :            :                              tree node, tree &node2, tree &node3, tree &node4)
    2101                 :            : {
    2102                 :       2605 :   gfc_se se;
    2103                 :       2605 :   tree ptr, ptr2;
    2104                 :            : 
    2105                 :       2605 :   gfc_init_se (&se, NULL);
    2106                 :            : 
    2107                 :       2605 :   if (element)
    2108                 :            :     {
    2109                 :         24 :       gfc_conv_expr_reference (&se, n->expr);
    2110                 :         24 :       gfc_add_block_to_block (block, &se.pre);
    2111                 :         24 :       ptr = se.expr;
    2112                 :         24 :       OMP_CLAUSE_SIZE (node) = TYPE_SIZE_UNIT (TREE_TYPE (ptr));
    2113                 :            :     }
    2114                 :            :   else
    2115                 :            :     {
    2116                 :       2581 :       gfc_conv_expr_descriptor (&se, n->expr);
    2117                 :       2581 :       ptr = gfc_conv_array_data (se.expr);
    2118                 :       2581 :       tree type = TREE_TYPE (se.expr);
    2119                 :       2581 :       gfc_add_block_to_block (block, &se.pre);
    2120                 :       5162 :       OMP_CLAUSE_SIZE (node) = gfc_full_array_size (block, se.expr,
    2121                 :       2581 :                                                     GFC_TYPE_ARRAY_RANK (type));
    2122                 :       2581 :       tree elemsz = TYPE_SIZE_UNIT (gfc_get_element_type (type));
    2123                 :       2581 :       elemsz = fold_convert (gfc_array_index_type, elemsz);
    2124                 :       2581 :       OMP_CLAUSE_SIZE (node) = fold_build2 (MULT_EXPR, gfc_array_index_type,
    2125                 :            :                                             OMP_CLAUSE_SIZE (node), elemsz);
    2126                 :            :     }
    2127                 :       2605 :   gfc_add_block_to_block (block, &se.post);
    2128                 :       2605 :   ptr = fold_convert (build_pointer_type (char_type_node), ptr);
    2129                 :       2605 :   OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
    2130                 :            : 
    2131                 :       4989 :   if (POINTER_TYPE_P (TREE_TYPE (decl))
    2132                 :        299 :       && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (decl)))
    2133                 :       2683 :       && ptr_kind == GOMP_MAP_POINTER)
    2134                 :            :     {
    2135                 :         78 :       node4 = build_omp_clause (input_location,
    2136                 :            :                                 OMP_CLAUSE_MAP);
    2137                 :         78 :       OMP_CLAUSE_SET_MAP_KIND (node4, GOMP_MAP_POINTER);
    2138                 :         78 :       OMP_CLAUSE_DECL (node4) = decl;
    2139                 :         78 :       OMP_CLAUSE_SIZE (node4) = size_int (0);
    2140                 :         78 :       decl = build_fold_indirect_ref (decl);
    2141                 :            :     }
    2142                 :       2605 :   ptr = fold_convert (sizetype, ptr);
    2143                 :       2605 :   if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
    2144                 :            :     {
    2145                 :       1625 :       tree type = TREE_TYPE (decl);
    2146                 :       1625 :       ptr2 = gfc_conv_descriptor_data_get (decl);
    2147                 :       1625 :       node2 = build_omp_clause (input_location,
    2148                 :            :                                 OMP_CLAUSE_MAP);
    2149                 :       1625 :       OMP_CLAUSE_SET_MAP_KIND (node2, GOMP_MAP_TO_PSET);
    2150                 :       1625 :       OMP_CLAUSE_DECL (node2) = decl;
    2151                 :       1625 :       OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type);
    2152                 :       1625 :       node3 = build_omp_clause (input_location,
    2153                 :            :                                 OMP_CLAUSE_MAP);
    2154                 :       1625 :       OMP_CLAUSE_SET_MAP_KIND (node3, ptr_kind);
    2155                 :       1625 :       OMP_CLAUSE_DECL (node3)
    2156                 :       1625 :         = gfc_conv_descriptor_data_get (decl);
    2157                 :       1625 :       if (ptr_kind == GOMP_MAP_ATTACH_DETACH)
    2158                 :         72 :         STRIP_NOPS (OMP_CLAUSE_DECL (node3));
    2159                 :            :     }
    2160                 :            :   else
    2161                 :            :     {
    2162                 :        980 :       if (TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE)
    2163                 :        759 :         ptr2 = build_fold_addr_expr (decl);
    2164                 :            :       else
    2165                 :            :         {
    2166                 :        221 :           gcc_assert (POINTER_TYPE_P (TREE_TYPE (decl)));
    2167                 :            :           ptr2 = decl;
    2168                 :            :         }
    2169                 :        980 :       node3 = build_omp_clause (input_location,
    2170                 :            :                                 OMP_CLAUSE_MAP);
    2171                 :        980 :       OMP_CLAUSE_SET_MAP_KIND (node3, ptr_kind);
    2172                 :        980 :       OMP_CLAUSE_DECL (node3) = decl;
    2173                 :            :     }
    2174                 :       2605 :   ptr2 = fold_convert (sizetype, ptr2);
    2175                 :       2605 :   OMP_CLAUSE_SIZE (node3)
    2176                 :       5210 :     = fold_build2 (MINUS_EXPR, sizetype, ptr, ptr2);
    2177                 :       2605 : }
    2178                 :            : 
    2179                 :            : static tree
    2180                 :      20012 : gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
    2181                 :            :                        locus where, bool declare_simd = false)
    2182                 :            : {
    2183                 :      20012 :   tree omp_clauses = NULL_TREE, chunk_size, c;
    2184                 :      20012 :   int list, ifc;
    2185                 :      20012 :   enum omp_clause_code clause_code;
    2186                 :      20012 :   gfc_se se;
    2187                 :            : 
    2188                 :      20012 :   if (clauses == NULL)
    2189                 :            :     return NULL_TREE;
    2190                 :            : 
    2191                 :     440000 :   for (list = 0; list < OMP_LIST_NUM; list++)
    2192                 :            :     {
    2193                 :     420000 :       gfc_omp_namelist *n = clauses->lists[list];
    2194                 :            : 
    2195                 :     420000 :       if (n == NULL)
    2196                 :     400996 :         continue;
    2197                 :      19004 :       switch (list)
    2198                 :            :         {
    2199                 :       2878 :         case OMP_LIST_REDUCTION:
    2200                 :            :           /* An OpenACC async clause indicates the need to set reduction
    2201                 :            :              arguments addressable, to allow asynchronous copy-out.  */
    2202                 :       2878 :           omp_clauses = gfc_trans_omp_reduction_list (n, omp_clauses, where,
    2203                 :       2878 :                                                       clauses->async);
    2204                 :       2878 :           break;
    2205                 :       4971 :         case OMP_LIST_PRIVATE:
    2206                 :       4971 :           clause_code = OMP_CLAUSE_PRIVATE;
    2207                 :       4971 :           goto add_clause;
    2208                 :        625 :         case OMP_LIST_SHARED:
    2209                 :        625 :           clause_code = OMP_CLAUSE_SHARED;
    2210                 :        625 :           goto add_clause;
    2211                 :        489 :         case OMP_LIST_FIRSTPRIVATE:
    2212                 :        489 :           clause_code = OMP_CLAUSE_FIRSTPRIVATE;
    2213                 :        489 :           goto add_clause;
    2214                 :        653 :         case OMP_LIST_LASTPRIVATE:
    2215                 :        653 :           clause_code = OMP_CLAUSE_LASTPRIVATE;
    2216                 :        653 :           goto add_clause;
    2217                 :         68 :         case OMP_LIST_COPYIN:
    2218                 :         68 :           clause_code = OMP_CLAUSE_COPYIN;
    2219                 :         68 :           goto add_clause;
    2220                 :         73 :         case OMP_LIST_COPYPRIVATE:
    2221                 :         73 :           clause_code = OMP_CLAUSE_COPYPRIVATE;
    2222                 :         73 :           goto add_clause;
    2223                 :         57 :         case OMP_LIST_UNIFORM:
    2224                 :         57 :           clause_code = OMP_CLAUSE_UNIFORM;
    2225                 :         57 :           goto add_clause;
    2226                 :        173 :         case OMP_LIST_USE_DEVICE:
    2227                 :        173 :         case OMP_LIST_USE_DEVICE_PTR:
    2228                 :        173 :           clause_code = OMP_CLAUSE_USE_DEVICE_PTR;
    2229                 :        173 :           goto add_clause;
    2230                 :        713 :         case OMP_LIST_USE_DEVICE_ADDR:
    2231                 :        713 :           clause_code = OMP_CLAUSE_USE_DEVICE_ADDR;
    2232                 :        713 :           goto add_clause;
    2233                 :         49 :         case OMP_LIST_IS_DEVICE_PTR:
    2234                 :         49 :           clause_code = OMP_CLAUSE_IS_DEVICE_PTR;
    2235                 :         49 :           goto add_clause;
    2236                 :            : 
    2237                 :       7871 :         add_clause:
    2238                 :       7871 :           omp_clauses
    2239                 :       7871 :             = gfc_trans_omp_variable_list (clause_code, n, omp_clauses,
    2240                 :            :                                            declare_simd);
    2241                 :       7871 :           break;
    2242                 :        166 :         case OMP_LIST_ALIGNED:
    2243                 :        166 :           for (; n != NULL; n = n->next)
    2244                 :        104 :             if (n->sym->attr.referenced || declare_simd)
    2245                 :            :               {
    2246                 :        104 :                 tree t = gfc_trans_omp_variable (n->sym, declare_simd);
    2247                 :        104 :                 if (t != error_mark_node)
    2248                 :            :                   {
    2249                 :        104 :                     tree node = build_omp_clause (input_location,
    2250                 :            :                                                   OMP_CLAUSE_ALIGNED);
    2251                 :        104 :                     OMP_CLAUSE_DECL (node) = t;
    2252                 :        104 :                     if (n->expr)
    2253                 :            :                       {
    2254                 :        104 :                         tree alignment_var;
    2255                 :            : 
    2256                 :        104 :                         if (declare_simd)
    2257                 :          0 :                           alignment_var = gfc_conv_constant_to_tree (n->expr);
    2258                 :            :                         else
    2259                 :            :                           {
    2260                 :        104 :                             gfc_init_se (&se, NULL);
    2261                 :        104 :                             gfc_conv_expr (&se, n->expr);
    2262                 :        104 :                             gfc_add_block_to_block (block, &se.pre);
    2263                 :        104 :                             alignment_var = gfc_evaluate_now (se.expr, block);
    2264                 :        104 :                             gfc_add_block_to_block (block, &se.post);
    2265                 :            :                           }
    2266                 :        104 :                         OMP_CLAUSE_ALIGNED_ALIGNMENT (node) = alignment_var;
    2267                 :            :                       }
    2268                 :        104 :                     omp_clauses = gfc_trans_add_clause (node, omp_clauses);
    2269                 :            :                   }
    2270                 :            :               }
    2271                 :            :           break;
    2272                 :            :         case OMP_LIST_LINEAR:
    2273                 :            :           {
    2274                 :            :             gfc_expr *last_step_expr = NULL;
    2275                 :            :             tree last_step = NULL_TREE;
    2276                 :            :             bool last_step_parm = false;
    2277                 :            : 
    2278                 :       1018 :             for (; n != NULL; n = n->next)
    2279                 :            :               {
    2280                 :        660 :                 if (n->expr)
    2281                 :            :                   {
    2282                 :        641 :                     last_step_expr = n->expr;
    2283                 :        641 :                     last_step = NULL_TREE;
    2284                 :        641 :                     last_step_parm = false;
    2285                 :            :                   }
    2286                 :        660 :                 if (n->sym->attr.referenced || declare_simd)
    2287                 :            :                   {
    2288                 :        660 :                     tree t = gfc_trans_omp_variable (n->sym, declare_simd);
    2289                 :        660 :                     if (t != error_mark_node)
    2290                 :            :                       {
    2291                 :        660 :                         tree node = build_omp_clause (input_location,
    2292                 :            :                                                       OMP_CLAUSE_LINEAR);
    2293                 :        660 :                         OMP_CLAUSE_DECL (node) = t;
    2294                 :        660 :                         omp_clause_linear_kind kind;
    2295                 :        660 :                         switch (n->u.linear_op)
    2296                 :            :                           {
    2297                 :            :                           case OMP_LINEAR_DEFAULT:
    2298                 :            :                             kind = OMP_CLAUSE_LINEAR_DEFAULT;
    2299                 :            :                             break;
    2300                 :            :                           case OMP_LINEAR_REF:
    2301                 :            :                             kind = OMP_CLAUSE_LINEAR_REF;
    2302                 :            :                             break;
    2303                 :            :                           case OMP_LINEAR_VAL:
    2304                 :            :                             kind = OMP_CLAUSE_LINEAR_VAL;
    2305                 :            :                             break;
    2306                 :            :                           case OMP_LINEAR_UVAL:
    2307                 :            :                             kind = OMP_CLAUSE_LINEAR_UVAL;
    2308                 :            :                             break;
    2309                 :          0 :                           default:
    2310                 :          0 :                             gcc_unreachable ();
    2311                 :            :                           }
    2312                 :        660 :                         OMP_CLAUSE_LINEAR_KIND (node) = kind;
    2313                 :        660 :                         if (last_step_expr && last_step == NULL_TREE)
    2314                 :            :                           {
    2315                 :        641 :                             if (!declare_simd)
    2316                 :            :                               {
    2317                 :        570 :                                 gfc_init_se (&se, NULL);
    2318                 :        570 :                                 gfc_conv_expr (&se, last_step_expr);
    2319                 :        570 :                                 gfc_add_block_to_block (block, &se.pre);
    2320                 :        570 :                                 last_step = gfc_evaluate_now (se.expr, block);
    2321                 :        570 :                                 gfc_add_block_to_block (block, &se.post);
    2322                 :            :                               }
    2323                 :         71 :                             else if (last_step_expr->expr_type == EXPR_VARIABLE)
    2324                 :            :                               {
    2325                 :          2 :                                 gfc_symbol *s = last_step_expr->symtree->n.sym;
    2326                 :          2 :                                 last_step = gfc_trans_omp_variable (s, true);
    2327                 :          2 :                                 last_step_parm = true;
    2328                 :            :                               }
    2329                 :            :                             else
    2330                 :         69 :                               last_step
    2331                 :         69 :                                 = gfc_conv_constant_to_tree (last_step_expr);
    2332                 :            :                           }
    2333                 :        660 :                         if (last_step_parm)
    2334                 :            :                           {
    2335                 :          2 :                             OMP_CLAUSE_LINEAR_VARIABLE_STRIDE (node) = 1;
    2336                 :          2 :                             OMP_CLAUSE_LINEAR_STEP (node) = last_step;
    2337                 :            :                           }
    2338                 :            :                         else
    2339                 :            :                           {
    2340                 :        658 :                             if (kind == OMP_CLAUSE_LINEAR_REF)
    2341                 :            :                               {
    2342                 :         26 :                                 tree type;
    2343                 :         26 :                                 if (n->sym->attr.flavor == FL_PROCEDURE)
    2344                 :            :                                   {
    2345                 :          0 :                                     type = gfc_get_function_type (n->sym);
    2346                 :          0 :                                     type = build_pointer_type (type);
    2347                 :            :                                   }
    2348                 :            :                                 else
    2349                 :         26 :                                   type = gfc_sym_type (n->sym);
    2350                 :         26 :                                 if (POINTER_TYPE_P (type))
    2351                 :         26 :                                   type = TREE_TYPE (type);
    2352                 :            :                                 /* Otherwise to be determined what exactly
    2353                 :            :                                    should be done.  */
    2354                 :         26 :                                 tree t = fold_convert (sizetype, last_step);
    2355                 :         26 :                                 t = size_binop (MULT_EXPR, t,
    2356                 :            :                                                 TYPE_SIZE_UNIT (type));
    2357                 :         26 :                                 OMP_CLAUSE_LINEAR_STEP (node) = t;
    2358                 :            :                               }
    2359                 :            :                             else
    2360                 :            :                               {
    2361                 :        632 :                                 tree type
    2362                 :        632 :                                   = gfc_typenode_for_spec (&n->sym->ts);
    2363                 :        632 :                                 OMP_CLAUSE_LINEAR_STEP (node)
    2364                 :        632 :                                   = fold_convert (type, last_step);
    2365                 :            :                               }
    2366                 :            :                           }
    2367                 :        660 :                         if (n->sym->attr.dimension || n->sym->attr.allocatable)
    2368                 :        222 :                           OMP_CLAUSE_LINEAR_ARRAY (node) = 1;
    2369                 :        660 :                         omp_clauses = gfc_trans_add_clause (node, omp_clauses);
    2370                 :            :                       }
    2371                 :            :                   }
    2372                 :            :               }
    2373                 :            :           }
    2374                 :            :           break;
    2375                 :       1040 :         case OMP_LIST_DEPEND:
    2376                 :       1040 :           for (; n != NULL; n = n->next)
    2377                 :            :             {
    2378                 :        565 :               if (n->u.depend_op == OMP_DEPEND_SINK_FIRST)
    2379                 :            :                 {
    2380                 :            :                   tree vec = NULL_TREE;
    2381                 :            :                   unsigned int i;
    2382                 :        990 :                   for (i = 0; ; i++)
    2383                 :            :                     {
    2384                 :       1206 :                       tree addend = integer_zero_node, t;
    2385                 :       1206 :                       bool neg = false;
    2386                 :       1206 :                       if (n->expr)
    2387                 :            :                         {
    2388                 :        546 :                           addend = gfc_conv_constant_to_tree (n->expr);
    2389                 :        546 :                           if (TREE_CODE (addend) == INTEGER_CST
    2390                 :        546 :                               && tree_int_cst_sgn (addend) == -1)
    2391                 :            :                             {
    2392                 :        396 :                               neg = true;
    2393                 :        396 :                               addend = const_unop (NEGATE_EXPR,
    2394                 :        396 :                                                    TREE_TYPE (addend), addend);
    2395                 :            :                             }
    2396                 :            :                         }
    2397                 :       1206 :                       t = gfc_trans_omp_variable (n->sym, false);
    2398                 :       1206 :                       if (t != error_mark_node)
    2399                 :            :                         {
    2400                 :       1206 :                           if (i < vec_safe_length (doacross_steps)
    2401                 :       1050 :                               && !integer_zerop (addend)
    2402                 :       1632 :                               && (*doacross_steps)[i])
    2403                 :            :                             {
    2404                 :        288 :                               tree step = (*doacross_steps)[i];
    2405                 :        288 :                               addend = fold_convert (TREE_TYPE (step), addend);
    2406                 :        288 :                               addend = build2 (TRUNC_DIV_EXPR,
    2407                 :        288 :                                                TREE_TYPE (step), addend, step);
    2408                 :            :                             }
    2409                 :       1206 :                           vec = tree_cons (addend, t, vec);
    2410                 :       1206 :                           if (neg)
    2411                 :        396 :                             OMP_CLAUSE_DEPEND_SINK_NEGATIVE (vec) = 1;
    2412                 :            :                         }
    2413                 :       1206 :                       if (n->next == NULL
    2414                 :       1056 :                           || n->next->u.depend_op != OMP_DEPEND_SINK)
    2415                 :            :                         break;
    2416                 :        990 :                       n = n->next;
    2417                 :        990 :                     }
    2418                 :        216 :                   if (vec == NULL_TREE)
    2419                 :          0 :                     continue;
    2420                 :            : 
    2421                 :        216 :                   tree node = build_omp_clause (input_location,
    2422                 :            :                                                 OMP_CLAUSE_DEPEND);
    2423                 :        216 :                   OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_SINK;
    2424                 :        216 :                   OMP_CLAUSE_DECL (node) = nreverse (vec);
    2425                 :        216 :                   omp_clauses = gfc_trans_add_clause (node, omp_clauses);
    2426                 :        216 :                   continue;
    2427                 :            :                 }
    2428                 :            : 
    2429                 :        349 :               if (!n->sym->attr.referenced)
    2430                 :          0 :                 continue;
    2431                 :            : 
    2432                 :        349 :               tree node = build_omp_clause (input_location, OMP_CLAUSE_DEPEND);
    2433                 :        349 :               if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
    2434                 :            :                 {
    2435                 :        265 :                   tree decl = gfc_trans_omp_variable (n->sym, false);
    2436                 :        265 :                   if (gfc_omp_privatize_by_reference (decl))
    2437                 :         26 :                     decl = build_fold_indirect_ref (decl);
    2438                 :        265 :                   if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
    2439                 :            :                     {
    2440                 :         10 :                       decl = gfc_conv_descriptor_data_get (decl);
    2441                 :         10 :                       decl = fold_convert (build_pointer_type (char_type_node),
    2442                 :            :                                            decl);
    2443                 :         10 :                       decl = build_fold_indirect_ref (decl);
    2444                 :            :                     }
    2445                 :        255 :                   else if (DECL_P (decl))
    2446                 :        237 :                     TREE_ADDRESSABLE (decl) = 1;
    2447                 :        265 :                   OMP_CLAUSE_DECL (node) = decl;
    2448                 :            :                 }
    2449                 :            :               else
    2450                 :            :                 {
    2451                 :         84 :                   tree ptr;
    2452                 :         84 :                   gfc_init_se (&se, NULL);
    2453                 :         84 :                   if (n->expr->ref->u.ar.type == AR_ELEMENT)
    2454                 :            :                     {
    2455                 :          6 :                       gfc_conv_expr_reference (&se, n->expr);
    2456                 :          6 :                       ptr = se.expr;
    2457                 :            :                     }
    2458                 :            :                   else
    2459                 :            :                     {
    2460                 :         78 :                       gfc_conv_expr_descriptor (&se, n->expr);
    2461                 :         78 :                       ptr = gfc_conv_array_data (se.expr);
    2462                 :            :                     }
    2463                 :         84 :                   gfc_add_block_to_block (block, &se.pre);
    2464                 :         84 :                   gfc_add_block_to_block (block, &se.post);
    2465                 :         84 :                   ptr = fold_convert (build_pointer_type (char_type_node),
    2466                 :            :                                       ptr);
    2467                 :         84 :                   OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
    2468                 :            :                 }
    2469                 :        349 :               switch (n->u.depend_op)
    2470                 :            :                 {
    2471                 :        180 :                 case OMP_DEPEND_IN:
    2472                 :        180 :                   OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_IN;
    2473                 :        180 :                   break;
    2474                 :        151 :                 case OMP_DEPEND_OUT:
    2475                 :        151 :                   OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_OUT;
    2476                 :        151 :                   break;
    2477                 :         18 :                 case OMP_DEPEND_INOUT:
    2478                 :         18 :                   OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_INOUT;
    2479                 :         18 :                   break;
    2480                 :          0 :                 default:
    2481                 :          0 :                   gcc_unreachable ();
    2482                 :            :                 }
    2483                 :        349 :               omp_clauses = gfc_trans_add_clause (node, omp_clauses);
    2484                 :            :             }
    2485                 :            :           break;
    2486                 :      15504 :         case OMP_LIST_MAP:
    2487                 :      15504 :           for (; n != NULL; n = n->next)
    2488                 :            :             {
    2489                 :       9871 :               if (!n->sym->attr.referenced)
    2490                 :          0 :                 continue;
    2491                 :            : 
    2492                 :       9871 :               tree node = build_omp_clause (input_location, OMP_CLAUSE_MAP);
    2493                 :       9871 :               tree node2 = NULL_TREE;
    2494                 :       9871 :               tree node3 = NULL_TREE;
    2495                 :       9871 :               tree node4 = NULL_TREE;
    2496                 :       9871 :               tree decl = gfc_trans_omp_variable (n->sym, false);
    2497                 :       9871 :               if (DECL_P (decl))
    2498                 :       9871 :                 TREE_ADDRESSABLE (decl) = 1;
    2499                 :       9871 :               if (n->expr == NULL
    2500                 :       2862 :                   || (n->expr->ref->type == REF_ARRAY
    2501                 :       2497 :                       && n->expr->ref->u.ar.type == AR_FULL))
    2502                 :            :                 {
    2503                 :       7009 :                   tree present = gfc_omp_check_optional_argument (decl, true);
    2504                 :       7009 :                   if (n->sym->ts.type == BT_CLASS)
    2505                 :            :                     {
    2506                 :         18 :                       tree type = TREE_TYPE (decl);
    2507                 :         18 :                       if (n->sym->attr.optional)
    2508                 :          0 :                         sorry ("optional class parameter");
    2509                 :         18 :                       if (POINTER_TYPE_P (type))
    2510                 :            :                         {
    2511                 :          6 :                           node4 = build_omp_clause (input_location,
    2512                 :            :                                                     OMP_CLAUSE_MAP);
    2513                 :          6 :                           OMP_CLAUSE_SET_MAP_KIND (node4, GOMP_MAP_POINTER);
    2514                 :          6 :                           OMP_CLAUSE_DECL (node4) = decl;
    2515                 :          6 :                           OMP_CLAUSE_SIZE (node4) = size_int (0);
    2516                 :          6 :                           decl = build_fold_indirect_ref (decl);
    2517                 :            :                         }
    2518                 :         18 :                       tree ptr = gfc_class_data_get (decl);
    2519                 :         18 :                       ptr = build_fold_indirect_ref (ptr);
    2520                 :         18 :                       OMP_CLAUSE_DECL (node) = ptr;
    2521                 :         18 :                       OMP_CLAUSE_SIZE (node) = gfc_class_vtab_size_get (decl);
    2522                 :         18 :                       node2 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
    2523                 :         18 :                       OMP_CLAUSE_SET_MAP_KIND (node2, GOMP_MAP_TO_PSET);
    2524                 :         18 :                       OMP_CLAUSE_DECL (node2) = decl;
    2525                 :         18 :                       OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type);
    2526                 :         18 :                       node3 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
    2527                 :         18 :                       OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_ATTACH_DETACH);
    2528                 :         18 :                       OMP_CLAUSE_DECL (node3) = gfc_class_data_get (decl);
    2529                 :         18 :                       OMP_CLAUSE_SIZE (node3) = size_int (0);
    2530                 :         18 :                       goto finalize_map_clause;
    2531                 :            :                     }
    2532                 :      12196 :                   else if (POINTER_TYPE_P (TREE_TYPE (decl))
    2533                 :       8090 :                            && (gfc_omp_privatize_by_reference (decl)
    2534                 :        237 :                                || GFC_DECL_GET_SCALAR_POINTER (decl)
    2535                 :        134 :                                || GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
    2536                 :         10 :                                || GFC_DECL_CRAY_POINTEE (decl)
    2537                 :         10 :                                || GFC_DESCRIPTOR_TYPE_P
    2538                 :            :                                              (TREE_TYPE (TREE_TYPE (decl)))
    2539                 :         10 :                                || n->sym->ts.type == BT_DERIVED))
    2540                 :            :                     {
    2541                 :       2881 :                       tree orig_decl = decl;
    2542                 :            : 
    2543                 :            :                       /* For nonallocatable, nonpointer arrays, a temporary
    2544                 :            :                          variable is generated, but this one is only defined if
    2545                 :            :                          the variable is present; hence, we now set it to NULL
    2546                 :            :                          to avoid accessing undefined variables.  We cannot use
    2547                 :            :                          a temporary variable here as otherwise the replacement
    2548                 :            :                          of the variables in omp-low.c will not work.  */
    2549                 :       3857 :                       if (present && GFC_ARRAY_TYPE_P (TREE_TYPE (decl)))
    2550                 :            :                         {
    2551                 :        277 :                           tree tmp = fold_build2_loc (input_location,
    2552                 :            :                                                       MODIFY_EXPR,
    2553                 :            :                                                       void_type_node, decl,
    2554                 :            :                                                       null_pointer_node);
    2555                 :        277 :                           tree cond = fold_build1_loc (input_location,
    2556                 :            :                                                        TRUTH_NOT_EXPR,
    2557                 :            :                                                        boolean_type_node,
    2558                 :            :                                                        present);
    2559                 :        554 :                           gfc_add_expr_to_block (block,
    2560                 :            :                                                  build3_loc (input_location,
    2561                 :            :                                                              COND_EXPR,
    2562                 :            :                                                              void_type_node,
    2563                 :            :                                                              cond, tmp,
    2564                 :            :                                                              NULL_TREE));
    2565                 :            :                         }
    2566                 :       2881 :                       node4 = build_omp_clause (input_location,
    2567                 :            :                                                 OMP_CLAUSE_MAP);
    2568                 :       2881 :                       OMP_CLAUSE_SET_MAP_KIND (node4, GOMP_MAP_POINTER);
    2569                 :       2881 :                       OMP_CLAUSE_DECL (node4) = decl;
    2570                 :       2881 :                       OMP_CLAUSE_SIZE (node4) = size_int (0);
    2571                 :       2881 :                       decl = build_fold_indirect_ref (decl);
    2572                 :       2881 :                       if ((TREE_CODE (TREE_TYPE (orig_decl)) == REFERENCE_TYPE
    2573                 :       1782 :                            || gfc_omp_is_optional_argument (orig_decl))
    2574                 :       4871 :                           && (GFC_DECL_GET_SCALAR_POINTER (orig_decl)
    2575                 :       1822 :                               || GFC_DECL_GET_SCALAR_ALLOCATABLE (orig_decl)))
    2576                 :            :                         {
    2577                 :        361 :                           node3 = build_omp_clause (input_location,
    2578                 :            :                                                     OMP_CLAUSE_MAP);
    2579                 :        361 :                           OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_POINTER);
    2580                 :        361 :                           OMP_CLAUSE_DECL (node3) = decl;
    2581                 :        361 :                           OMP_CLAUSE_SIZE (node3) = size_int (0);
    2582                 :        361 :                           decl = build_fold_indirect_ref (decl);
    2583                 :            :                         }
    2584                 :            :                     }
    2585                 :       6991 :                   if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))
    2586                 :        856 :                       && n->u.map_op != OMP_MAP_ATTACH
    2587                 :       7847 :                       && n->u.map_op != OMP_MAP_DETACH)
    2588                 :            :                     {
    2589                 :        856 :                       tree type = TREE_TYPE (decl);
    2590                 :        856 :                       tree ptr = gfc_conv_descriptor_data_get (decl);
    2591                 :        856 :                       if (present)
    2592                 :        301 :                         ptr = gfc_build_cond_assign_expr (block, present, ptr,
    2593                 :            :                                                           null_pointer_node);
    2594                 :        856 :                       ptr = fold_convert (build_pointer_type (char_type_node),
    2595                 :            :                                           ptr);
    2596                 :        856 :                       ptr = build_fold_indirect_ref (ptr);
    2597                 :        856 :                       OMP_CLAUSE_DECL (node) = ptr;
    2598                 :        856 :                       node2 = build_omp_clause (input_location,
    2599                 :            :                                                 OMP_CLAUSE_MAP);
    2600                 :        856 :                       OMP_CLAUSE_SET_MAP_KIND (node2, GOMP_MAP_TO_PSET);
    2601                 :        856 :                       OMP_CLAUSE_DECL (node2) = decl;
    2602                 :        856 :                       OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type);
    2603                 :        856 :                       node3 = build_omp_clause (input_location,
    2604                 :            :                                                 OMP_CLAUSE_MAP);
    2605                 :        856 :                       OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_POINTER);
    2606                 :        856 :                       if (present)
    2607                 :            :                         {
    2608                 :        301 :                           ptr = gfc_conv_descriptor_data_get (decl);
    2609                 :        301 :                           ptr = gfc_build_addr_expr (NULL, ptr);
    2610                 :        301 :                           ptr = gfc_build_cond_assign_expr (block, present, ptr,
    2611                 :            :                                                             null_pointer_node);
    2612                 :        301 :                           ptr = build_fold_indirect_ref (ptr);
    2613                 :        301 :                           OMP_CLAUSE_DECL (node3) = ptr;
    2614                 :            :                         }
    2615                 :            :                       else
    2616                 :        555 :                         OMP_CLAUSE_DECL (node3)
    2617                 :        555 :                           = gfc_conv_descriptor_data_get (decl);
    2618                 :        856 :                       OMP_CLAUSE_SIZE (node3) = size_int (0);
    2619                 :            : 
    2620                 :            :                       /* We have to check for n->sym->attr.dimension because
    2621                 :            :                          of scalar coarrays.  */
    2622                 :        856 :                       if (n->sym->attr.pointer && n->sym->attr.dimension)
    2623                 :            :                         {
    2624                 :        372 :                           stmtblock_t cond_block;
    2625                 :        372 :                           tree size
    2626                 :        372 :                             = gfc_create_var (gfc_array_index_type, NULL);
    2627                 :        372 :                           tree tem, then_b, else_b, zero, cond;
    2628                 :            : 
    2629                 :        372 :                           gfc_init_block (&cond_block);
    2630                 :        372 :                           tem
    2631                 :        744 :                             = gfc_full_array_size (&cond_block, decl,
    2632                 :        372 :                                                    GFC_TYPE_ARRAY_RANK (type));
    2633                 :        372 :                           gfc_add_modify (&cond_block, size, tem);
    2634                 :        372 :                           then_b = gfc_finish_block (&cond_block);
    2635                 :        372 :                           gfc_init_block (&cond_block);
    2636                 :        372 :                           zero = build_int_cst (gfc_array_index_type, 0);
    2637                 :        372 :                           gfc_add_modify (&cond_block, size, zero);
    2638                 :        372 :                           else_b = gfc_finish_block (&cond_block);
    2639                 :        372 :                           tem = gfc_conv_descriptor_data_get (decl);
    2640                 :        372 :                           tem = fold_convert (pvoid_type_node, tem);
    2641                 :        372 :                           cond = fold_build2_loc (input_location, NE_EXPR,
    2642                 :            :                                                   boolean_type_node,
    2643                 :            :                                                   tem, null_pointer_node);
    2644                 :        372 :                           if (present)
    2645                 :        132 :                             cond = fold_build2_loc (input_location,
    2646                 :            :                                                     TRUTH_ANDIF_EXPR,
    2647                 :            :                                                     boolean_type_node,
    2648                 :            :                                                     present, cond);
    2649                 :        744 :                           gfc_add_expr_to_block (block,
    2650                 :            :                                                  build3_loc (input_location,
    2651                 :            :                                                              COND_EXPR,
    2652                 :            :                                                              void_type_node,
    2653                 :            :                                                              cond, then_b,
    2654                 :            :                                                              else_b));
    2655                 :        372 :                           OMP_CLAUSE_SIZE (node) = size;
    2656                 :            :                         }
    2657                 :        484 :                       else if (n->sym->attr.dimension)
    2658                 :            :                         {
    2659                 :        484 :                           stmtblock_t cond_block;
    2660                 :        484 :                           gfc_init_block (&cond_block);
    2661                 :        484 :                           tree size = gfc_full_array_size (&cond_block, decl,
    2662                 :        484 :                                         GFC_TYPE_ARRAY_RANK (type));
    2663                 :        484 :                           if (present)
    2664                 :            :                             {
    2665                 :        169 :                               tree var = gfc_create_var (gfc_array_index_type,
    2666                 :            :                                                          NULL);
    2667                 :        169 :                               gfc_add_modify (&cond_block, var, size);
    2668                 :        169 :                               tree cond_body = gfc_finish_block (&cond_block);
    2669                 :        169 :                               tree cond = build3_loc (input_location, COND_EXPR,
    2670                 :            :                                                       void_type_node, present,
    2671                 :            :                                                       cond_body, NULL_TREE);
    2672                 :        169 :                               gfc_add_expr_to_block (block, cond);
    2673                 :        169 :                               OMP_CLAUSE_SIZE (node) = var;
    2674                 :            :                             }
    2675                 :            :                           else
    2676                 :            :                             {
    2677                 :        315 :                               gfc_add_block_to_block (block, &cond_block);
    2678                 :        315 :                               OMP_CLAUSE_SIZE (node) = size;
    2679                 :            :                             }
    2680                 :            :                         }
    2681                 :        856 :                       if (n->sym->attr.dimension)
    2682                 :            :                         {
    2683                 :        856 :                           tree elemsz
    2684                 :        856 :                             = TYPE_SIZE_UNIT (gfc_get_element_type (type));
    2685                 :        856 :                           elemsz = fold_convert (gfc_array_index_type, elemsz);
    2686                 :       1712 :                           OMP_CLAUSE_SIZE (node)
    2687                 :       1712 :                             = fold_build2 (MULT_EXPR, gfc_array_index_type,
    2688                 :            :                                            OMP_CLAUSE_SIZE (node), elemsz);
    2689                 :            :                         }
    2690                 :            :                     }
    2691                 :       6135 :                   else if (present
    2692                 :        747 :                            && TREE_CODE (decl) == INDIRECT_REF
    2693                 :       6810 :                            && (TREE_CODE (TREE_OPERAND (decl, 0))
    2694                 :            :                                == INDIRECT_REF))
    2695                 :            :                     {
    2696                 :            :                       /* A single indirectref is handled by the middle end.  */
    2697                 :        193 :                       gcc_assert (!POINTER_TYPE_P (TREE_TYPE (decl)));
    2698                 :        193 :                       decl = TREE_OPERAND (decl, 0);
    2699                 :        193 :                       decl = gfc_build_cond_assign_expr (block, present, decl,
    2700                 :            :                                                          null_pointer_node);
    2701                 :        193 :                       OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (decl);
    2702                 :            :                     }
    2703                 :            :                   else
    2704                 :       5942 :                     OMP_CLAUSE_DECL (node) = decl;
    2705                 :            :                 }
    2706                 :       2862 :               else if (n->expr
    2707                 :       2862 :                        && n->expr->expr_type == EXPR_VARIABLE
    2708                 :       2862 :                        && n->expr->ref->type == REF_COMPONENT)
    2709                 :            :                 {
    2710                 :            :                   gfc_ref *lastcomp;
    2711                 :            : 
    2712                 :       1064 :                   for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
    2713                 :        699 :                     if (ref->type == REF_COMPONENT)
    2714                 :        426 :                       lastcomp = ref;
    2715                 :            : 
    2716                 :        365 :                   symbol_attribute sym_attr;
    2717                 :            : 
    2718                 :        365 :                   if (lastcomp->u.c.component->ts.type == BT_CLASS)
    2719                 :         12 :                     sym_attr = CLASS_DATA (lastcomp->u.c.component)->attr;
    2720                 :            :                   else
    2721                 :        353 :                     sym_attr = lastcomp->u.c.component->attr;
    2722                 :            : 
    2723                 :        365 :                   gfc_init_se (&se, NULL);
    2724                 :            : 
    2725                 :        365 :                   if (!sym_attr.dimension
    2726                 :         92 :                       && lastcomp->u.c.component->ts.type != BT_CLASS
    2727                 :         80 :                       && lastcomp->u.c.component->ts.type != BT_DERIVED)
    2728                 :            :                     {
    2729                 :            :                       /* Last component is a scalar.  */
    2730                 :         62 :                       gfc_conv_expr (&se, n->expr);
    2731                 :         62 :                       gfc_add_block_to_block (block, &se.pre);
    2732                 :         62 :                       OMP_CLAUSE_DECL (node) = se.expr;
    2733                 :         62 :                       gfc_add_block_to_block (block, &se.post);
    2734                 :         86 :                       goto finalize_map_clause;
    2735                 :            :                     }
    2736                 :            : 
    2737                 :        303 :                   se.expr = gfc_maybe_dereference_var (n->sym, decl);
    2738                 :            : 
    2739                 :        303 :                   for (gfc_ref *ref = n->expr->ref;
    2740                 :        667 :                        ref && ref != lastcomp->next;
    2741                 :        364 :                        ref = ref->next)
    2742                 :            :                     {
    2743                 :        364 :                       if (ref->type == REF_COMPONENT)
    2744                 :            :                         {
    2745                 :        364 :                           if (ref->u.c.sym->attr.extension)
    2746                 :         61 :                             conv_parent_component_references (&se, ref);
    2747                 :            : 
    2748                 :        364 :                           gfc_conv_component_ref (&se, ref);
    2749                 :            :                         }
    2750                 :            :                       else
    2751                 :          0 :                         sorry ("unhandled derived-type component");
    2752                 :            :                     }
    2753                 :            : 
    2754                 :        303 :                   tree inner = se.expr;
    2755                 :            : 
    2756                 :            :                   /* Last component is a derived type or class pointer.  */
    2757                 :        303 :                   if (lastcomp->u.c.component->ts.type == BT_DERIVED
    2758                 :        285 :                       || lastcomp->u.c.component->ts.type == BT_CLASS)
    2759                 :            :                     {
    2760                 :         30 :                       if (sym_attr.allocatable || sym_attr.pointer)
    2761                 :            :                         {
    2762                 :         12 :                           tree data, size;
    2763                 :            : 
    2764                 :         12 :                           if (lastcomp->u.c.component->ts.type == BT_CLASS)
    2765                 :            :                             {
    2766                 :         12 :                               data = gfc_class_data_get (inner);
    2767                 :         12 :                               size = gfc_class_vtab_size_get (inner);
    2768                 :            :                             }
    2769                 :            :                           else  /* BT_DERIVED.  */
    2770                 :            :                             {
    2771                 :          0 :                               data = inner;
    2772                 :          0 :                               size = TYPE_SIZE_UNIT (TREE_TYPE (inner));
    2773                 :            :                             }
    2774                 :            : 
    2775                 :         12 :                           OMP_CLAUSE_DECL (node)
    2776                 :         12 :                             = build_fold_indirect_ref (data);
    2777                 :         12 :                           OMP_CLAUSE_SIZE (node) = size;
    2778                 :         12 :                           node2 = build_omp_clause (input_location,
    2779                 :            :                                                     OMP_CLAUSE_MAP);
    2780                 :         12 :                           OMP_CLAUSE_SET_MAP_KIND (node2,
    2781                 :            :                                                    GOMP_MAP_ATTACH_DETACH);
    2782                 :         12 :                           OMP_CLAUSE_DECL (node2) = data;
    2783                 :         12 :                           OMP_CLAUSE_SIZE (node2) = size_int (0);
    2784                 :            :                         }
    2785                 :            :                       else
    2786                 :            :                         {
    2787                 :         18 :                           OMP_CLAUSE_DECL (node) = decl;
    2788                 :         36 :                           OMP_CLAUSE_SIZE (node)
    2789                 :         36 :                             = TYPE_SIZE_UNIT (TREE_TYPE (decl));
    2790                 :            :                         }
    2791                 :            :                     }
    2792                 :        273 :                   else if (lastcomp->next
    2793                 :        273 :                            && lastcomp->next->type == REF_ARRAY
    2794                 :        273 :                            && lastcomp->next->u.ar.type == AR_FULL)
    2795                 :            :                     {
    2796                 :            :                       /* Just pass the (auto-dereferenced) decl through for
    2797                 :            :                          bare attach and detach clauses.  */
    2798                 :        165 :                       if (n->u.map_op == OMP_MAP_ATTACH
    2799                 :        147 :                           || n->u.map_op == OMP_MAP_DETACH)
    2800                 :            :                         {
    2801                 :         24 :                           OMP_CLAUSE_DECL (node) = inner;
    2802                 :         24 :                           OMP_CLAUSE_SIZE (node) = size_zero_node;
    2803                 :         24 :                           goto finalize_map_clause;
    2804                 :            :                         }
    2805                 :            : 
    2806                 :        141 :                       if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (inner)))
    2807                 :            :                         {
    2808                 :         67 :                           tree type = TREE_TYPE (inner);
    2809                 :         67 :                           tree ptr = gfc_conv_descriptor_data_get (inner);
    2810                 :         67 :                           ptr = build_fold_indirect_ref (ptr);
    2811                 :         67 :                           OMP_CLAUSE_DECL (node) = ptr;
    2812                 :         67 :                           node2 = build_omp_clause (input_location,
    2813                 :            :                                                     OMP_CLAUSE_MAP);
    2814                 :         67 :                           OMP_CLAUSE_SET_MAP_KIND (node2, GOMP_MAP_TO_PSET);
    2815                 :         67 :                           OMP_CLAUSE_DECL (node2) = inner;
    2816                 :         67 :                           OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type);
    2817                 :         67 :                           node3 = build_omp_clause (input_location,
    2818                 :            :                                                     OMP_CLAUSE_MAP);
    2819                 :         67 :                           OMP_CLAUSE_SET_MAP_KIND (node3,
    2820                 :            :                                                    GOMP_MAP_ATTACH_DETACH);
    2821                 :         67 :                           OMP_CLAUSE_DECL (node3)
    2822                 :         67 :                             = gfc_conv_descriptor_data_get (inner);
    2823                 :         67 :                           STRIP_NOPS (OMP_CLAUSE_DECL (node3));
    2824                 :         67 :                           OMP_CLAUSE_SIZE (node3) = size_int (0);
    2825                 :         67 :                           int rank = GFC_TYPE_ARRAY_RANK (type);
    2826                 :         67 :                           OMP_CLAUSE_SIZE (node)
    2827                 :         67 :                             = gfc_full_array_size (block, inner, rank);
    2828                 :         67 :                           tree elemsz
    2829                 :         67 :                             = TYPE_SIZE_UNIT (gfc_get_element_type (type));
    2830                 :         67 :                           elemsz = fold_convert (gfc_array_index_type, elemsz);
    2831                 :        134 :                           OMP_CLAUSE_SIZE (node)
    2832                 :        134 :                             = fold_build2 (MULT_EXPR, gfc_array_index_type,
    2833                 :            :                                            OMP_CLAUSE_SIZE (node), elemsz);
    2834                 :            :                         }
    2835                 :            :                       else
    2836                 :         74 :                         OMP_CLAUSE_DECL (node) = inner;
    2837                 :            :                     }
    2838                 :            :                   else  /* An array element or section.  */
    2839                 :            :                     {
    2840                 :        216 :                       bool element
    2841                 :            :                         = (lastcomp->next
    2842                 :        108 :                            && lastcomp->next->type == REF_ARRAY
    2843                 :        216 :                            && lastcomp->next->u.ar.type == AR_ELEMENT);
    2844                 :            : 
    2845                 :        108 :                       gfc_trans_omp_array_section (block, n, inner, element,
    2846                 :            :                                                    GOMP_MAP_ATTACH_DETACH,
    2847                 :            :                                                    node, node2, node3, node4);
    2848                 :        279 :                     }
    2849                 :            :                 }
    2850                 :            :               else  /* An array element or array section.  */
    2851                 :            :                 {
    2852                 :       2497 :                   bool element = n->expr->ref->u.ar.type == AR_ELEMENT;
    2853                 :       2497 :                   gfc_trans_omp_array_section (block, n, decl, element,
    2854                 :            :                                                GOMP_MAP_POINTER, node, node2,
    2855                 :            :                                                node3, node4);
    2856                 :            :                 }
    2857                 :            : 
    2858                 :       9871 :               finalize_map_clause:
    2859                 :       9871 :               switch (n->u.map_op)
    2860                 :            :                 {
    2861                 :        732 :                 case OMP_MAP_ALLOC:
    2862                 :        732 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALLOC);
    2863                 :        732 :                   break;
    2864                 :         63 :                 case OMP_MAP_IF_PRESENT:
    2865                 :         63 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_IF_PRESENT);
    2866                 :         63 :                   break;
    2867                 :         18 :                 case OMP_MAP_ATTACH:
    2868                 :         18 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ATTACH);
    2869                 :         18 :                   break;
    2870                 :       2711 :                 case OMP_MAP_TO:
    2871                 :       2711 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_TO);
    2872                 :       2711 :                   break;
    2873                 :       1916 :                 case OMP_MAP_FROM:
    2874                 :       1916 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FROM);
    2875                 :       1916 :                   break;
    2876                 :       2913 :                 case OMP_MAP_TOFROM:
    2877                 :       2913 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_TOFROM);
    2878                 :       2913 :                   break;
    2879                 :          0 :                 case OMP_MAP_ALWAYS_TO:
    2880                 :          0 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_TO);
    2881                 :          0 :                   break;
    2882                 :          0 :                 case OMP_MAP_ALWAYS_FROM:
    2883                 :          0 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_FROM);
    2884                 :          0 :                   break;
    2885                 :          0 :                 case OMP_MAP_ALWAYS_TOFROM:
    2886                 :          0 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_TOFROM);
    2887                 :          0 :                   break;
    2888                 :        227 :                 case OMP_MAP_RELEASE:
    2889                 :        227 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_RELEASE);
    2890                 :        227 :                   break;
    2891                 :          0 :                 case OMP_MAP_DELETE:
    2892                 :          0 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_DELETE);
    2893                 :          0 :                   break;
    2894                 :          6 :                 case OMP_MAP_DETACH:
    2895                 :          6 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_DETACH);
    2896                 :          6 :                   break;
    2897                 :         38 :                 case OMP_MAP_FORCE_ALLOC:
    2898                 :         38 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_ALLOC);
    2899                 :         38 :                   break;
    2900                 :        357 :                 case OMP_MAP_FORCE_TO:
    2901                 :        357 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_TO);
    2902                 :        357 :                   break;
    2903                 :        393 :                 case OMP_MAP_FORCE_FROM:
    2904                 :        393 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_FROM);
    2905                 :        393 :                   break;
    2906                 :          0 :                 case OMP_MAP_FORCE_TOFROM:
    2907                 :          0 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_TOFROM);
    2908                 :          0 :                   break;
    2909                 :        494 :                 case OMP_MAP_FORCE_PRESENT:
    2910                 :        494 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_PRESENT);
    2911                 :        494 :                   break;
    2912                 :          3 :                 case OMP_MAP_FORCE_DEVICEPTR:
    2913                 :          3 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_DEVICEPTR);
    2914                 :          3 :                   break;
    2915                 :          0 :                 default:
    2916                 :          0 :                   gcc_unreachable ();
    2917                 :            :                 }
    2918                 :       9871 :               omp_clauses = gfc_trans_add_clause (node, omp_clauses);
    2919                 :       9871 :               if (node2)
    2920                 :       2578 :                 omp_clauses = gfc_trans_add_clause (node2, omp_clauses);
    2921                 :       9871 :               if (node3)
    2922                 :       3907 :                 omp_clauses = gfc_trans_add_clause (node3, omp_clauses);
    2923                 :       9871 :               if (node4)
    2924                 :       2965 :                 omp_clauses = gfc_trans_add_clause (node4, omp_clauses);
    2925                 :            :             }
    2926                 :            :           break;
    2927                 :       3496 :         case OMP_LIST_TO:
    2928                 :       3496 :         case OMP_LIST_FROM:
    2929                 :       3496 :         case OMP_LIST_CACHE:
    2930                 :       3496 :           for (; n != NULL; n = n->next)
    2931                 :            :             {
    2932                 :       1769 :               if (!n->sym->attr.referenced)
    2933                 :          0 :                 continue;
    2934                 :            : 
    2935                 :       1769 :               switch (list)
    2936                 :            :                 {
    2937                 :            :                 case OMP_LIST_TO:
    2938                 :            :                   clause_code = OMP_CLAUSE_TO;
    2939                 :            :                   break;
    2940                 :        990 :                 case OMP_LIST_FROM:
    2941                 :        990 :                   clause_code = OMP_CLAUSE_FROM;
    2942                 :        990 :                   break;
    2943                 :         58 :                 case OMP_LIST_CACHE:
    2944                 :         58 :                   clause_code = OMP_CLAUSE__CACHE_;
    2945                 :         58 :                   break;
    2946                 :          0 :                 default:
    2947                 :          0 :                   gcc_unreachable ();
    2948                 :            :                 }
    2949                 :       1769 :               tree node = build_omp_clause (input_location, clause_code);
    2950                 :       1769 :               if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
    2951                 :            :                 {
    2952                 :       1682 :                   tree decl = gfc_trans_omp_variable (n->sym, false);
    2953                 :       1682 :                   if (gfc_omp_privatize_by_reference (decl))
    2954                 :            :                     {
    2955                 :       1047 :                       if (gfc_omp_is_allocatable_or_ptr (decl))
    2956                 :        240 :                         decl = build_fold_indirect_ref (decl);
    2957                 :       1047 :                       decl = build_fold_indirect_ref (decl);
    2958                 :            :                     }
    2959                 :        635 :                   else if (DECL_P (decl))
    2960                 :        635 :                     TREE_ADDRESSABLE (decl) = 1;
    2961                 :       1682 :                   if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
    2962                 :            :                     {
    2963                 :        584 :                       tree type = TREE_TYPE (decl);
    2964                 :        584 :                       tree ptr = gfc_conv_descriptor_data_get (decl);
    2965                 :        584 :                       ptr = fold_convert (build_pointer_type (char_type_node),
    2966                 :            :                                           ptr);
    2967                 :        584 :                       ptr = build_fold_indirect_ref (ptr);
    2968                 :        584 :                       OMP_CLAUSE_DECL (node) = ptr;
    2969                 :       1168 :                       OMP_CLAUSE_SIZE (node)
    2970                 :        584 :                         = gfc_full_array_size (block, decl,
    2971                 :        584 :                                                GFC_TYPE_ARRAY_RANK (type));
    2972                 :        584 :                       tree elemsz
    2973                 :        584 :                         = TYPE_SIZE_UNIT (gfc_get_element_type (type));
    2974                 :        584 :                       elemsz = fold_convert (gfc_array_index_type, elemsz);
    2975                 :       1168 :                       OMP_CLAUSE_SIZE (node)
    2976                 :       1168 :                         = fold_build2 (MULT_EXPR, gfc_array_index_type,
    2977                 :            :                                        OMP_CLAUSE_SIZE (node), elemsz);
    2978                 :            :                     }
    2979                 :            :                   else
    2980                 :            :                     {
    2981                 :       1098 :                       OMP_CLAUSE_DECL (node) = decl;
    2982                 :       1098 :                       if (gfc_omp_is_allocatable_or_ptr (decl))
    2983                 :        240 :                         OMP_CLAUSE_SIZE (node)
    2984                 :        240 :                                 = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (decl)));
    2985                 :            :                     }
    2986                 :            :                 }
    2987                 :            :               else
    2988                 :            :                 {
    2989                 :         87 :                   tree ptr;
    2990                 :         87 :                   gfc_init_se (&se, NULL);
    2991                 :         87 :                   if (n->expr->ref->u.ar.type == AR_ELEMENT)
    2992                 :            :                     {
    2993                 :          0 :                       gfc_conv_expr_reference (&se, n->expr);
    2994                 :          0 :                       ptr = se.expr;
    2995                 :          0 :                       gfc_add_block_to_block (block, &se.pre);
    2996                 :          0 :                       OMP_CLAUSE_SIZE (node)
    2997                 :          0 :                         = TYPE_SIZE_UNIT (TREE_TYPE (ptr));
    2998                 :            :                     }
    2999                 :            :                   else
    3000                 :            :                     {
    3001                 :         87 :                       gfc_conv_expr_descriptor (&se, n->expr);
    3002                 :         87 :                       ptr = gfc_conv_array_data (se.expr);
    3003                 :         87 :                       tree type = TREE_TYPE (se.expr);
    3004                 :         87 :                       gfc_add_block_to_block (block, &se.pre);
    3005                 :        174 :                       OMP_CLAUSE_SIZE (node)
    3006                 :         87 :                         = gfc_full_array_size (block, se.expr,
    3007                 :         87 :                                                GFC_TYPE_ARRAY_RANK (type));
    3008                 :         87 :                       tree elemsz
    3009                 :         87 :                         = TYPE_SIZE_UNIT (gfc_get_element_type (type));
    3010                 :         87 :                       elemsz = fold_convert (gfc_array_index_type, elemsz);
    3011                 :        174 :                       OMP_CLAUSE_SIZE (node)
    3012                 :        174 :                         = fold_build2 (MULT_EXPR, gfc_array_index_type,
    3013                 :            :                                        OMP_CLAUSE_SIZE (node), elemsz);
    3014                 :            :                     }
    3015                 :         87 :                   gfc_add_block_to_block (block, &se.post);
    3016                 :         87 :                   ptr = fold_convert (build_pointer_type (char_type_node),
    3017                 :            :                                       ptr);
    3018                 :         87 :                   OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
    3019                 :            :                 }
    3020                 :       1769 :               omp_clauses = gfc_trans_add_clause (node, omp_clauses);
    3021                 :            :             }
    3022                 :            :           break;
    3023                 :            :         default:
    3024                 :            :           break;
    3025                 :            :         }
    3026                 :            :     }
    3027                 :            : 
    3028                 :      20000 :   if (clauses->if_expr)
    3029                 :            :     {
    3030                 :        660 :       tree if_var;
    3031                 :            : 
    3032                 :        660 :       gfc_init_se (&se, NULL);
    3033                 :        660 :       gfc_conv_expr (&se, clauses->if_expr);
    3034                 :        660 :       gfc_add_block_to_block (block, &se.pre);
    3035                 :        660 :       if_var = gfc_evaluate_now (se.expr, block);
    3036                 :        660 :       gfc_add_block_to_block (block, &se.post);
    3037                 :            : 
    3038                 :        660 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_IF);
    3039                 :        660 :       OMP_CLAUSE_IF_MODIFIER (c) = ERROR_MARK;
    3040                 :        660 :       OMP_CLAUSE_IF_EXPR (c) = if_var;
    3041                 :        660 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3042                 :            :     }
    3043                 :     180000 :   for (ifc = 0; ifc < OMP_IF_LAST; ifc++)
    3044                 :     160000 :     if (clauses->if_exprs[ifc])
    3045                 :            :       {
    3046                 :          0 :         tree if_var;
    3047                 :            : 
    3048                 :          0 :         gfc_init_se (&se, NULL);
    3049                 :          0 :         gfc_conv_expr (&se, clauses->if_exprs[ifc]);
    3050                 :          0 :         gfc_add_block_to_block (block, &se.pre);
    3051                 :          0 :         if_var = gfc_evaluate_now (se.expr, block);
    3052                 :          0 :         gfc_add_block_to_block (block, &se.post);
    3053                 :            : 
    3054                 :          0 :         c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_IF);
    3055                 :          0 :         switch (ifc)
    3056                 :            :           {
    3057                 :          0 :           case OMP_IF_PARALLEL:
    3058                 :          0 :             OMP_CLAUSE_IF_MODIFIER (c) = OMP_PARALLEL;
    3059                 :          0 :             break;
    3060                 :          0 :           case OMP_IF_TASK:
    3061                 :          0 :             OMP_CLAUSE_IF_MODIFIER (c) = OMP_TASK;
    3062                 :          0 :             break;
    3063                 :          0 :           case OMP_IF_TASKLOOP:
    3064                 :          0 :             OMP_CLAUSE_IF_MODIFIER (c) = OMP_TASKLOOP;
    3065                 :          0 :             break;
    3066                 :          0 :           case OMP_IF_TARGET:
    3067                 :          0 :             OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET;
    3068                 :          0 :             break;
    3069                 :          0 :           case OMP_IF_TARGET_DATA:
    3070                 :          0 :             OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET_DATA;
    3071                 :          0 :             break;
    3072                 :          0 :           case OMP_IF_TARGET_UPDATE:
    3073                 :          0 :             OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET_UPDATE;
    3074                 :          0 :             break;
    3075                 :          0 :           case OMP_IF_TARGET_ENTER_DATA:
    3076                 :          0 :             OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET_ENTER_DATA;
    3077                 :          0 :             break;
    3078                 :          0 :           case OMP_IF_TARGET_EXIT_DATA:
    3079                 :          0 :             OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET_EXIT_DATA;
    3080                 :          0 :             break;
    3081                 :            :           default:
    3082                 :            :             gcc_unreachable ();
    3083                 :            :           }
    3084                 :          0 :         OMP_CLAUSE_IF_EXPR (c) = if_var;
    3085                 :          0 :         omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3086                 :            :       }
    3087                 :            : 
    3088                 :      20000 :   if (clauses->final_expr)
    3089                 :            :     {
    3090                 :          6 :       tree final_var;
    3091                 :            : 
    3092                 :          6 :       gfc_init_se (&se, NULL);
    3093                 :          6 :       gfc_conv_expr (&se, clauses->final_expr);
    3094                 :          6 :       gfc_add_block_to_block (block, &se.pre);
    3095                 :          6 :       final_var = gfc_evaluate_now (se.expr, block);
    3096                 :          6 :       gfc_add_block_to_block (block, &se.post);
    3097                 :            : 
    3098                 :          6 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_FINAL);
    3099                 :          6 :       OMP_CLAUSE_FINAL_EXPR (c) = final_var;
    3100                 :          6 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3101                 :            :     }
    3102                 :            : 
    3103                 :      20000 :   if (clauses->num_threads)
    3104                 :            :     {
    3105                 :        868 :       tree num_threads;
    3106                 :            : 
    3107                 :        868 :       gfc_init_se (&se, NULL);
    3108                 :        868 :       gfc_conv_expr (&se, clauses->num_threads);
    3109                 :        868 :       gfc_add_block_to_block (block, &se.pre);
    3110                 :        868 :       num_threads = gfc_evaluate_now (se.expr, block);
    3111                 :        868 :       gfc_add_block_to_block (block, &se.post);
    3112                 :            : 
    3113                 :        868 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_THREADS);
    3114                 :        868 :       OMP_CLAUSE_NUM_THREADS_EXPR (c) = num_threads;
    3115                 :        868 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3116                 :            :     }
    3117                 :            : 
    3118                 :      20000 :   chunk_size = NULL_TREE;
    3119                 :      20000 :   if (clauses->chunk_size)
    3120                 :            :     {
    3121                 :        425 :       gfc_init_se (&se, NULL);
    3122                 :        425 :       gfc_conv_expr (&se, clauses->chunk_size);
    3123                 :        425 :       gfc_add_block_to_block (block, &se.pre);
    3124                 :        425 :       chunk_size = gfc_evaluate_now (se.expr, block);
    3125                 :        425 :       gfc_add_block_to_block (block, &se.post);
    3126                 :            :     }
    3127                 :            : 
    3128                 :      20000 :   if (clauses->sched_kind != OMP_SCHED_NONE)
    3129                 :            :     {
    3130                 :        632 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SCHEDULE);
    3131                 :        632 :       OMP_CLAUSE_SCHEDULE_CHUNK_EXPR (c) = chunk_size;
    3132                 :        632 :       switch (clauses->sched_kind)
    3133                 :            :         {
    3134                 :        328 :         case OMP_SCHED_STATIC:
    3135                 :        328 :           OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_STATIC;
    3136                 :        328 :           break;
    3137                 :        131 :         case OMP_SCHED_DYNAMIC:
    3138                 :        131 :           OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_DYNAMIC;
    3139                 :        131 :           break;
    3140                 :         97 :         case OMP_SCHED_GUIDED:
    3141                 :         97 :           OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_GUIDED;
    3142                 :         97 :           break;
    3143                 :         75 :         case OMP_SCHED_RUNTIME:
    3144                 :         75 :           OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_RUNTIME;
    3145                 :         75 :           break;
    3146                 :          1 :         case OMP_SCHED_AUTO:
    3147                 :          1 :           OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_AUTO;
    3148                 :          1 :           break;
    3149                 :          0 :         default:
    3150                 :          0 :           gcc_unreachable ();
    3151                 :            :         }
    3152                 :        632 :       if (clauses->sched_monotonic)
    3153                 :         22 :         OMP_CLAUSE_SCHEDULE_KIND (c)
    3154                 :         22 :           = (omp_clause_schedule_kind) (OMP_CLAUSE_SCHEDULE_KIND (c)
    3155                 :         11 :                                         | OMP_CLAUSE_SCHEDULE_MONOTONIC);
    3156                 :        621 :       else if (clauses->sched_nonmonotonic)
    3157                 :         14 :         OMP_CLAUSE_SCHEDULE_KIND (c)
    3158                 :         14 :           = (omp_clause_schedule_kind) (OMP_CLAUSE_SCHEDULE_KIND (c)
    3159                 :          7 :                                         | OMP_CLAUSE_SCHEDULE_NONMONOTONIC);
    3160                 :        632 :       if (clauses->sched_simd)
    3161                 :          5 :         OMP_CLAUSE_SCHEDULE_SIMD (c) = 1;
    3162                 :        632 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3163                 :            :     }
    3164                 :            : 
    3165                 :      20000 :   if (clauses->default_sharing != OMP_DEFAULT_UNKNOWN)
    3166                 :            :     {
    3167                 :        534 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEFAULT);
    3168                 :        534 :       switch (clauses->default_sharing)
    3169                 :            :         {
    3170                 :        233 :         case OMP_DEFAULT_NONE:
    3171                 :        233 :           OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_NONE;
    3172                 :        233 :           break;
    3173                 :         85 :         case OMP_DEFAULT_SHARED:
    3174                 :         85 :           OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_SHARED;
    3175                 :         85 :           break;
    3176                 :         24 :         case OMP_DEFAULT_PRIVATE:
    3177                 :         24 :           OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_PRIVATE;
    3178                 :         24 :           break;
    3179                 :          6 :         case OMP_DEFAULT_FIRSTPRIVATE:
    3180                 :          6 :           OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_FIRSTPRIVATE;
    3181                 :          6 :           break;
    3182                 :        186 :         case OMP_DEFAULT_PRESENT:
    3183                 :        186 :           OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_PRESENT;
    3184                 :        186 :           break;
    3185                 :          0 :         default:
    3186                 :          0 :           gcc_unreachable ();
    3187                 :            :         }
    3188                 :        534 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3189                 :            :     }
    3190                 :            : 
    3191                 :      20000 :   if (clauses->nowait)
    3192                 :            :     {
    3193                 :       1131 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NOWAIT);
    3194                 :       1131 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3195                 :            :     }
    3196                 :            : 
    3197                 :      20000 :   if (clauses->ordered)
    3198                 :            :     {
    3199                 :        281 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_ORDERED);
    3200                 :        281 :       OMP_CLAUSE_ORDERED_EXPR (c)
    3201                 :        281 :         = clauses->orderedc ? build_int_cst (integer_type_node,
    3202                 :        120 :                                              clauses->orderedc) : NULL_TREE;
    3203                 :        281 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3204                 :            :     }
    3205                 :            : 
    3206                 :      20000 :   if (clauses->untied)
    3207                 :            :     {
    3208                 :          1 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_UNTIED);
    3209                 :          1 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3210                 :            :     }
    3211                 :            : 
    3212                 :      20000 :   if (clauses->mergeable)
    3213                 :            :     {
    3214                 :          0 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_MERGEABLE);
    3215                 :          0 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3216                 :            :     }
    3217                 :            : 
    3218                 :      20000 :   if (clauses->collapse)
    3219                 :            :     {
    3220                 :        590 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_COLLAPSE);
    3221                 :        590 :       OMP_CLAUSE_COLLAPSE_EXPR (c)
    3222                 :       1180 :         = build_int_cst (integer_type_node, clauses->collapse);
    3223                 :        590 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3224                 :            :     }
    3225                 :            : 
    3226                 :      20000 :   if (clauses->inbranch)
    3227                 :            :     {
    3228                 :         14 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_INBRANCH);
    3229                 :         14 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3230                 :            :     }
    3231                 :            : 
    3232                 :      20000 :   if (clauses->notinbranch)
    3233                 :            :     {
    3234                 :         18 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NOTINBRANCH);
    3235                 :         18 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3236                 :            :     }
    3237                 :            : 
    3238                 :      20000 :   switch (clauses->cancel)
    3239                 :            :     {
    3240                 :            :     case OMP_CANCEL_UNKNOWN:
    3241                 :            :       break;
    3242                 :          0 :     case OMP_CANCEL_PARALLEL:
    3243                 :          0 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_PARALLEL);
    3244                 :          0 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3245                 :          0 :       break;
    3246                 :          0 :     case OMP_CANCEL_SECTIONS:
    3247                 :          0 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SECTIONS);
    3248                 :          0 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3249                 :          0 :       break;
    3250                 :          0 :     case OMP_CANCEL_DO:
    3251                 :          0 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_FOR);
    3252                 :          0 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3253                 :          0 :       break;
    3254                 :          0 :     case OMP_CANCEL_TASKGROUP:
    3255                 :          0 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_TASKGROUP);
    3256                 :          0 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3257                 :          0 :       break;
    3258                 :            :     }
    3259                 :            : 
    3260                 :      20000 :   if (clauses->proc_bind != OMP_PROC_BIND_UNKNOWN)
    3261                 :            :     {
    3262                 :         20 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_PROC_BIND);
    3263                 :         20 :       switch (clauses->proc_bind)
    3264                 :            :         {
    3265                 :          9 :         case OMP_PROC_BIND_MASTER:
    3266                 :          9 :           OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_MASTER;
    3267                 :          9 :           break;
    3268                 :         10 :         case OMP_PROC_BIND_SPREAD:
    3269                 :         10 :           OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_SPREAD;
    3270                 :         10 :           break;
    3271                 :          1 :         case OMP_PROC_BIND_CLOSE:
    3272                 :          1 :           OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_CLOSE;
    3273                 :          1 :           break;
    3274                 :          0 :         default:
    3275                 :          0 :           gcc_unreachable ();
    3276                 :            :         }
    3277                 :         20 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3278                 :            :     }
    3279                 :            : 
    3280                 :      20000 :   if (clauses->safelen_expr)
    3281                 :            :     {
    3282                 :         53 :       tree safelen_var;
    3283                 :            : 
    3284                 :         53 :       gfc_init_se (&se, NULL);
    3285                 :         53 :       gfc_conv_expr (&se, clauses->safelen_expr);
    3286                 :         53 :       gfc_add_block_to_block (block, &se.pre);
    3287                 :         53 :       safelen_var = gfc_evaluate_now (se.expr, block);
    3288                 :         53 :       gfc_add_block_to_block (block, &se.post);
    3289                 :            : 
    3290                 :         53 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SAFELEN);
    3291                 :         53 :       OMP_CLAUSE_SAFELEN_EXPR (c) = safelen_var;
    3292                 :         53 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3293                 :            :     }
    3294                 :            : 
    3295                 :      20000 :   if (clauses->simdlen_expr)
    3296                 :            :     {
    3297                 :         42 :       if (declare_simd)
    3298                 :            :         {
    3299                 :         42 :           c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SIMDLEN);
    3300                 :         42 :           OMP_CLAUSE_SIMDLEN_EXPR (c)
    3301                 :         84 :             = gfc_conv_constant_to_tree (clauses->simdlen_expr);
    3302                 :         42 :           omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3303                 :            :         }
    3304                 :            :       else
    3305                 :            :         {
    3306                 :          0 :           tree simdlen_var;
    3307                 :            : 
    3308                 :          0 :           gfc_init_se (&se, NULL);
    3309                 :          0 :           gfc_conv_expr (&se, clauses->simdlen_expr);
    3310                 :          0 :           gfc_add_block_to_block (block, &se.pre);
    3311                 :          0 :           simdlen_var = gfc_evaluate_now (se.expr, block);
    3312                 :          0 :           gfc_add_block_to_block (block, &se.post);
    3313                 :            : 
    3314                 :          0 :           c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SIMDLEN);
    3315                 :          0 :           OMP_CLAUSE_SIMDLEN_EXPR (c) = simdlen_var;
    3316                 :          0 :           omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3317                 :            :         }
    3318                 :            :     }
    3319                 :            : 
    3320                 :      20000 :   if (clauses->num_teams)
    3321                 :            :     {
    3322                 :         59 :       tree num_teams;
    3323                 :            : 
    3324                 :         59 :       gfc_init_se (&se, NULL);
    3325                 :         59 :       gfc_conv_expr (&se, clauses->num_teams);
    3326                 :         59 :       gfc_add_block_to_block (block, &se.pre);
    3327                 :         59 :       num_teams = gfc_evaluate_now (se.expr, block);
    3328                 :         59 :       gfc_add_block_to_block (block, &se.post);
    3329                 :            : 
    3330                 :         59 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_TEAMS);
    3331                 :         59 :       OMP_CLAUSE_NUM_TEAMS_EXPR (c) = num_teams;
    3332                 :         59 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3333                 :            :     }
    3334                 :            : 
    3335                 :      20000 :   if (clauses->device)
    3336                 :            :     {
    3337                 :         44 :       tree device;
    3338                 :            : 
    3339                 :         44 :       gfc_init_se (&se, NULL);
    3340                 :         44 :       gfc_conv_expr (&se, clauses->device);
    3341                 :         44 :       gfc_add_block_to_block (block, &se.pre);
    3342                 :         44 :       device = gfc_evaluate_now (se.expr, block);
    3343                 :         44 :       gfc_add_block_to_block (block, &se.post);
    3344                 :            : 
    3345                 :         44 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEVICE);
    3346                 :         44 :       OMP_CLAUSE_DEVICE_ID (c) = device;
    3347                 :         44 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3348                 :            :     }
    3349                 :            : 
    3350                 :      20000 :   if (clauses->thread_limit)
    3351                 :            :     {
    3352                 :         47 :       tree thread_limit;
    3353                 :            : 
    3354                 :         47 :       gfc_init_se (&se, NULL);
    3355                 :         47 :       gfc_conv_expr (&se, clauses->thread_limit);
    3356                 :         47 :       gfc_add_block_to_block (block, &se.pre);
    3357                 :         47 :       thread_limit = gfc_evaluate_now (se.expr, block);
    3358                 :         47 :       gfc_add_block_to_block (block, &se.post);
    3359                 :            : 
    3360                 :         47 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_THREAD_LIMIT);
    3361                 :         47 :       OMP_CLAUSE_THREAD_LIMIT_EXPR (c) = thread_limit;
    3362                 :         47 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3363                 :            :     }
    3364                 :            : 
    3365                 :      20000 :   chunk_size = NULL_TREE;
    3366                 :      20000 :   if (clauses->dist_chunk_size)
    3367                 :            :     {
    3368                 :         57 :       gfc_init_se (&se, NULL);
    3369                 :         57 :       gfc_conv_expr (&se, clauses->dist_chunk_size);
    3370                 :         57 :       gfc_add_block_to_block (block, &se.pre);
    3371                 :         57 :       chunk_size = gfc_evaluate_now (se.expr, block);
    3372                 :         57 :       gfc_add_block_to_block (block, &se.post);
    3373                 :            :     }
    3374                 :            : 
    3375                 :      20000 :   if (clauses->dist_sched_kind != OMP_SCHED_NONE)
    3376                 :            :     {
    3377                 :         57 :       c = build_omp_clause (gfc_get_location (&where),
    3378                 :            :                             OMP_CLAUSE_DIST_SCHEDULE);
    3379                 :         57 :       OMP_CLAUSE_DIST_SCHEDULE_CHUNK_EXPR (c) = chunk_size;
    3380                 :         57 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3381                 :            :     }
    3382                 :            : 
    3383                 :      20000 :   if (clauses->grainsize)
    3384                 :            :     {
    3385                 :          1 :       tree grainsize;
    3386                 :            : 
    3387                 :          1 :       gfc_init_se (&se, NULL);
    3388                 :          1 :       gfc_conv_expr (&se, clauses->grainsize);
    3389                 :          1 :       gfc_add_block_to_block (block, &se.pre);
    3390                 :          1 :       grainsize = gfc_evaluate_now (se.expr, block);
    3391                 :          1 :       gfc_add_block_to_block (block, &se.post);
    3392                 :            : 
    3393                 :          1 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_GRAINSIZE);
    3394                 :          1 :       OMP_CLAUSE_GRAINSIZE_EXPR (c) = grainsize;
    3395                 :          1 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3396                 :            :     }
    3397                 :            : 
    3398                 :      20000 :   if (clauses->num_tasks)
    3399                 :            :     {
    3400                 :          1 :       tree num_tasks;
    3401                 :            : 
    3402                 :          1 :       gfc_init_se (&se, NULL);
    3403                 :          1 :       gfc_conv_expr (&se, clauses->num_tasks);
    3404                 :          1 :       gfc_add_block_to_block (block, &se.pre);
    3405                 :          1 :       num_tasks = gfc_evaluate_now (se.expr, block);
    3406                 :          1 :       gfc_add_block_to_block (block, &se.post);
    3407                 :            : 
    3408                 :          1 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_TASKS);
    3409                 :          1 :       OMP_CLAUSE_NUM_TASKS_EXPR (c) = num_tasks;
    3410                 :          1 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3411                 :            :     }
    3412                 :            : 
    3413                 :      20000 :   if (clauses->priority)
    3414                 :            :     {
    3415                 :          0 :       tree priority;
    3416                 :            : 
    3417                 :          0 :       gfc_init_se (&se, NULL);
    3418                 :          0 :       gfc_conv_expr (&se, clauses->priority);
    3419                 :          0 :       gfc_add_block_to_block (block, &se.pre);
    3420                 :          0 :       priority = gfc_evaluate_now (se.expr, block);
    3421                 :          0 :       gfc_add_block_to_block (block, &se.post);
    3422                 :            : 
    3423                 :          0 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_PRIORITY);
    3424                 :          0 :       OMP_CLAUSE_PRIORITY_EXPR (c) = priority;
    3425                 :          0 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3426                 :            :     }
    3427                 :            : 
    3428                 :      20000 :   if (clauses->hint)
    3429                 :            :     {
    3430                 :          0 :       tree hint;
    3431                 :            : 
    3432                 :          0 :       gfc_init_se (&se, NULL);
    3433                 :          0 :       gfc_conv_expr (&se, clauses->hint);
    3434                 :          0 :       gfc_add_block_to_block (block, &se.pre);
    3435                 :          0 :       hint = gfc_evaluate_now (se.expr, block);
    3436                 :          0 :       gfc_add_block_to_block (block, &se.post);
    3437                 :            : 
    3438                 :          0 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_HINT);
    3439                 :          0 :       OMP_CLAUSE_HINT_EXPR (c) = hint;
    3440                 :          0 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3441                 :            :     }
    3442                 :            : 
    3443                 :      20000 :   if (clauses->simd)
    3444                 :            :     {
    3445                 :          2 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SIMD);
    3446                 :          2 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3447                 :            :     }
    3448                 :      20000 :   if (clauses->threads)
    3449                 :            :     {
    3450                 :          0 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_THREADS);
    3451                 :          0 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3452                 :            :     }
    3453                 :      20000 :   if (clauses->nogroup)
    3454                 :            :     {
    3455                 :          8 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NOGROUP);
    3456                 :          8 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3457                 :            :     }
    3458                 :      20000 :   if (clauses->defaultmap)
    3459                 :            :     {
    3460                 :          6 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEFAULTMAP);
    3461                 :          6 :       OMP_CLAUSE_DEFAULTMAP_SET_KIND (c, OMP_CLAUSE_DEFAULTMAP_TOFROM,
    3462                 :            :                                       OMP_CLAUSE_DEFAULTMAP_CATEGORY_SCALAR);
    3463                 :          6 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3464                 :            :     }
    3465                 :      20000 :   if (clauses->depend_source)
    3466                 :            :     {
    3467                 :        120 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEPEND);
    3468                 :        120 :       OMP_CLAUSE_DEPEND_KIND (c) = OMP_CLAUSE_DEPEND_SOURCE;
    3469                 :        120 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3470                 :            :     }
    3471                 :            : 
    3472                 :      20000 :   if (clauses->async)
    3473                 :            :     {
    3474                 :        539 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_ASYNC);
    3475                 :        539 :       if (clauses->async_expr)
    3476                 :        539 :         OMP_CLAUSE_ASYNC_EXPR (c)
    3477                 :        539 :           = gfc_convert_expr_to_tree (block, clauses->async_expr);
    3478                 :            :       else
    3479                 :          0 :         OMP_CLAUSE_ASYNC_EXPR (c) = NULL;
    3480                 :        539 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3481                 :            :     }
    3482                 :      20000 :   if (clauses->seq)
    3483                 :            :     {
    3484                 :         94 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SEQ);
    3485                 :         94 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3486                 :            :     }
    3487                 :      20000 :   if (clauses->par_auto)
    3488                 :            :     {
    3489                 :         51 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_AUTO);
    3490                 :         51 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3491                 :            :     }
    3492                 :      20000 :   if (clauses->if_present)
    3493                 :            :     {
    3494                 :         23 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_IF_PRESENT);
    3495                 :         23 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3496                 :            :     }
    3497                 :      20000 :   if (clauses->finalize)
    3498                 :            :     {
    3499                 :         12 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_FINALIZE);
    3500                 :         12 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3501                 :            :     }
    3502                 :      20000 :   if (clauses->independent)
    3503                 :            :     {
    3504                 :        163 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_INDEPENDENT);
    3505                 :        163 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3506                 :            :     }
    3507                 :      20000 :   if (clauses->wait_list)
    3508                 :            :     {
    3509                 :            :       gfc_expr_list *el;
    3510                 :            : 
    3511                 :        317 :       for (el = clauses->wait_list; el; el = el->next)
    3512                 :            :         {
    3513                 :        172 :           c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_WAIT);
    3514                 :        172 :           OMP_CLAUSE_DECL (c) = gfc_convert_expr_to_tree (block, el->expr);
    3515                 :        172 :           OMP_CLAUSE_CHAIN (c) = omp_clauses;
    3516                 :        172 :           omp_clauses = c;
    3517                 :            :         }
    3518                 :            :     }
    3519                 :      20000 :   if (clauses->num_gangs_expr)
    3520                 :            :     {
    3521                 :        624 :       tree num_gangs_var
    3522                 :        624 :         = gfc_convert_expr_to_tree (block, clauses->num_gangs_expr);
    3523                 :        624 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_GANGS);
    3524                 :        624 :       OMP_CLAUSE_NUM_GANGS_EXPR (c) = num_gangs_var;
    3525                 :        624 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3526                 :            :     }
    3527                 :      20000 :   if (clauses->num_workers_expr)
    3528                 :            :     {
    3529                 :        547 :       tree num_workers_var
    3530                 :        547 :         = gfc_convert_expr_to_tree (block, clauses->num_workers_expr);
    3531                 :        547 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_WORKERS);
    3532                 :        547 :       OMP_CLAUSE_NUM_WORKERS_EXPR (c) = num_workers_var;
    3533                 :        547 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3534                 :            :     }
    3535                 :      20000 :   if (clauses->vector_length_expr)
    3536                 :            :     {
    3537                 :        553 :       tree vector_length_var
    3538                 :        553 :         = gfc_convert_expr_to_tree (block, clauses->vector_length_expr);
    3539                 :        553 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_VECTOR_LENGTH);
    3540                 :        553 :       OMP_CLAUSE_VECTOR_LENGTH_EXPR (c) = vector_length_var;
    3541                 :        553 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3542                 :            :     }
    3543                 :      20000 :   if (clauses->tile_list)
    3544                 :            :     {
    3545                 :        102 :       vec<tree, va_gc> *tvec;
    3546                 :        102 :       gfc_expr_list *el;
    3547                 :            : 
    3548                 :        102 :       vec_alloc (tvec, 4);
    3549                 :            : 
    3550                 :        260 :       for (el = clauses->tile_list; el; el = el->next)
    3551                 :        158 :         vec_safe_push (tvec, gfc_convert_expr_to_tree (block, el->expr));
    3552                 :            : 
    3553                 :        102 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_TILE);
    3554                 :        102 :       OMP_CLAUSE_TILE_LIST (c) = build_tree_list_vec (tvec);
    3555                 :        102 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3556                 :        102 :       tvec->truncate (0);
    3557                 :            :     }
    3558                 :      20000 :   if (clauses->vector)
    3559                 :            :     {
    3560                 :        788 :       if (clauses->vector_expr)
    3561                 :            :         {
    3562                 :        109 :           tree vector_var
    3563                 :        109 :             = gfc_convert_expr_to_tree (block, clauses->vector_expr);
    3564                 :        109 :           c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_VECTOR);
    3565                 :        109 :           OMP_CLAUSE_VECTOR_EXPR (c) = vector_var;
    3566                 :        109 :           omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3567                 :            :         }
    3568                 :            :       else
    3569                 :            :         {
    3570                 :        679 :           c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_VECTOR);
    3571                 :        679 :           omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3572                 :            :         }
    3573                 :            :     }
    3574                 :      20000 :   if (clauses->worker)
    3575                 :            :     {
    3576                 :        678 :       if (clauses->worker_expr)
    3577                 :            :         {
    3578                 :         79 :           tree worker_var
    3579                 :         79 :             = gfc_convert_expr_to_tree (block, clauses->worker_expr);
    3580                 :         79 :           c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_WORKER);
    3581                 :         79 :           OMP_CLAUSE_WORKER_EXPR (c) = worker_var;
    3582                 :         79 :           omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3583                 :            :         }
    3584                 :            :       else
    3585                 :            :         {
    3586                 :        599 :           c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_WORKER);
    3587                 :        599 :           omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3588                 :            :         }
    3589                 :            :     }
    3590                 :      20000 :   if (clauses->gang)
    3591                 :            :     {
    3592                 :        875 :       tree arg;
    3593                 :        875 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_GANG);
    3594                 :        875 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3595                 :        875 :       if (clauses->gang_num_expr)
    3596                 :            :         {
    3597                 :         91 :           arg = gfc_convert_expr_to_tree (block, clauses->gang_num_expr);
    3598                 :         91 :           OMP_CLAUSE_GANG_EXPR (c) = arg;
    3599                 :            :         }
    3600                 :        875 :       if (clauses->gang_static)
    3601                 :            :         {
    3602                 :        202 :           arg = clauses->gang_static_expr
    3603                 :        101 :             ? gfc_convert_expr_to_tree (block, clauses->gang_static_expr)
    3604                 :            :             : integer_minus_one_node;
    3605                 :        101 :           OMP_CLAUSE_GANG_STATIC_EXPR (c) = arg;
    3606                 :            :         }
    3607                 :            :     }
    3608                 :            : 
    3609                 :      20000 :   return nreverse (omp_clauses);
    3610                 :            : }
    3611                 :            : 
    3612                 :            : /* Like gfc_trans_code, but force creation of a BIND_EXPR around it.  */
    3613                 :            : 
    3614                 :            : static tree
    3615                 :      13988 : gfc_trans_omp_code (gfc_code *code, bool force_empty)
    3616                 :            : {
    3617                 :      13988 :   tree stmt;
    3618                 :            : 
    3619                 :      13988 :   pushlevel ();
    3620                 :      13988 :   stmt = gfc_trans_code (code);
    3621                 :      13988 :   if (TREE_CODE (stmt) != BIND_EXPR)
    3622                 :            :     {
    3623                 :      12952 :       if (!IS_EMPTY_STMT (stmt) || force_empty)
    3624                 :            :         {
    3625                 :      12195 :           tree block = poplevel (1, 0);
    3626                 :      12195 :           stmt = build3_v (BIND_EXPR, NULL, stmt, block);
    3627                 :            :         }
    3628                 :            :       else
    3629                 :         65 :         poplevel (0, 0);
    3630                 :            :     }
    3631                 :            :   else
    3632                 :       1728 :     poplevel (0, 0);
    3633                 :      13988 :   return stmt;
    3634                 :            : }
    3635                 :            : 
    3636                 :            : /* Translate OpenACC 'parallel', 'kernels', 'serial', 'data', 'host_data'
    3637                 :            :    construct. */
    3638                 :            : 
    3639                 :            : static tree
    3640                 :       3424 : gfc_trans_oacc_construct (gfc_code *code)
    3641                 :            : {
    3642                 :       3424 :   stmtblock_t block;
    3643                 :       3424 :   tree stmt, oacc_clauses;
    3644                 :       3424 :   enum tree_code construct_code;
    3645                 :            : 
    3646                 :       3424 :   switch (code->op)
    3647                 :            :     {
    3648                 :            :       case EXEC_OACC_PARALLEL:
    3649                 :            :         construct_code = OACC_PARALLEL;
    3650                 :            :         break;
    3651                 :            :       case EXEC_OACC_KERNELS:
    3652                 :            :         construct_code = OACC_KERNELS;
    3653                 :            :         break;
    3654                 :            :       case EXEC_OACC_SERIAL:
    3655                 :            :         construct_code = OACC_SERIAL;
    3656                 :            :         break;
    3657                 :            :       case EXEC_OACC_DATA:
    3658                 :            :         construct_code = OACC_DATA;
    3659                 :            :         break;
    3660                 :            :       case EXEC_OACC_HOST_DATA:
    3661                 :            :         construct_code = OACC_HOST_DATA;
    3662                 :            :         break;
    3663                 :          0 :       default:
    3664                 :          0 :         gcc_unreachable ();
    3665                 :            :     }
    3666                 :            : 
    3667                 :       3424 :   gfc_start_block (&block);
    3668                 :       3424 :   oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
    3669                 :            :                                         code->loc);
    3670                 :       3424 :   stmt = gfc_trans_omp_code (code->block->next, true);
    3671                 :       3424 :   stmt = build2_loc (input_location, construct_code, void_type_node, stmt,
    3672                 :            :                      oacc_clauses);
    3673                 :       3424 :   gfc_add_expr_to_block (&block, stmt);
    3674                 :       3424 :   return gfc_finish_block (&block);
    3675                 :            : }
    3676                 :            : 
    3677                 :            : /* update, enter_data, exit_data, cache. */
    3678                 :            : static tree 
    3679                 :       1176 : gfc_trans_oacc_executable_directive (gfc_code *code)
    3680                 :            : {
    3681                 :       1176 :   stmtblock_t block;
    3682                 :       1176 :   tree stmt, oacc_clauses;
    3683                 :       1176 :   enum tree_code construct_code;
    3684                 :            : 
    3685                 :       1176 :   switch (code->op)
    3686                 :            :     {
    3687                 :            :       case EXEC_OACC_UPDATE:
    3688                 :            :         construct_code = OACC_UPDATE;
    3689                 :            :         break;
    3690                 :        329 :       case EXEC_OACC_ENTER_DATA:
    3691                 :        329 :         construct_code = OACC_ENTER_DATA;
    3692                 :        329 :         break;
    3693                 :        320 :       case EXEC_OACC_EXIT_DATA:
    3694                 :        320 :         construct_code = OACC_EXIT_DATA;
    3695                 :        320 :         break;
    3696                 :         58 :       case EXEC_OACC_CACHE:
    3697                 :         58 :         construct_code = OACC_CACHE;
    3698                 :         58 :         break;
    3699                 :          0 :       default:
    3700                 :          0 :         gcc_unreachable ();
    3701                 :            :     }
    3702                 :            : 
    3703                 :       1176 :   gfc_start_block (&block);
    3704                 :       1176 :   oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
    3705                 :            :                                         code->loc);
    3706                 :       1176 :   stmt = build1_loc (input_location, construct_code, void_type_node, 
    3707                 :            :                      oacc_clauses);
    3708                 :       1176 :   gfc_add_expr_to_block (&block, stmt);
    3709                 :       1176 :   return gfc_finish_block (&block);
    3710                 :            : }
    3711                 :            : 
    3712                 :            : static tree
    3713                 :        167 : gfc_trans_oacc_wait_directive (gfc_code *code)
    3714                 :            : {
    3715                 :        167 :   stmtblock_t block;
    3716                 :        167 :   tree stmt, t;
    3717                 :        167 :   vec<tree, va_gc> *args;
    3718                 :        167 :   int nparms = 0;
    3719                 :        167 :   gfc_expr_list *el;
    3720                 :        167 :   gfc_omp_clauses *clauses = code->ext.omp_clauses;
    3721                 :        167 :   location_t loc = input_location;
    3722                 :            : 
    3723                 :        291 :   for (el = clauses->wait_list; el; el = el->next)
    3724                 :        124 :     nparms++;
    3725                 :            : 
    3726                 :        167 :   vec_alloc (args, nparms + 2);
    3727                 :        167 :   stmt = builtin_decl_explicit (BUILT_IN_GOACC_WAIT);
    3728                 :            : 
    3729                 :        167 :   gfc_start_block (&block);
    3730                 :            : 
    3731                 :        167 :   if (clauses->async_expr)
    3732                 :          0 :     t = gfc_convert_expr_to_tree (&block, clauses->async_expr);
    3733                 :            :   else
    3734                 :        167 :     t = build_int_cst (integer_type_node, -2);
    3735                 :            : 
    3736                 :        167 :   args->quick_push (t);
    3737                 :        167 :   args->quick_push (build_int_cst (integer_type_node, nparms));
    3738                 :            : 
    3739                 :        291 :   for (el = clauses->wait_list; el; el = el->next)
    3740                 :        124 :     args->quick_push (gfc_convert_expr_to_tree (&block, el->expr));
    3741                 :            : 
    3742                 :        167 :   stmt = build_call_expr_loc_vec (loc, stmt, args);
    3743                 :        167 :   gfc_add_expr_to_block (&block, stmt);
    3744                 :            : 
    3745                 :        167 :   vec_free (args);
    3746                 :            : 
    3747                 :        167 :   return gfc_finish_block (&block);
    3748                 :            : }
    3749                 :            : 
    3750                 :            : static tree gfc_trans_omp_sections (gfc_code *, gfc_omp_clauses *);
    3751                 :            : static tree gfc_trans_omp_workshare (gfc_code *, gfc_omp_clauses *);
    3752                 :            : 
    3753                 :            : static tree
    3754                 :       1623 : gfc_trans_omp_atomic (gfc_code *code)
    3755                 :            : {
    3756                 :       1623 :   gfc_code *atomic_code = code;
    3757                 :       1623 :   gfc_se lse;
    3758                 :       1623 :   gfc_se rse;
    3759                 :       1623 :   gfc_se vse;
    3760                 :       1623 :   gfc_expr *expr2, *e;
    3761                 :       1623 :   gfc_symbol *var;
    3762                 :       1623 :   stmtblock_t block;
    3763                 :       1623 :   tree lhsaddr, type, rhs, x;
    3764                 :       1623 :   enum tree_code op = ERROR_MARK;
    3765                 :       1623 :   enum tree_code aop = OMP_ATOMIC;
    3766                 :       1623 :   bool var_on_left = false;
    3767                 :       3246 :   enum omp_memory_order mo
    3768                 :       1623 :     = ((atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SEQ_CST)
    3769                 :       1623 :        ? OMP_MEMORY_ORDER_SEQ_CST : OMP_MEMORY_ORDER_RELAXED);
    3770                 :            : 
    3771                 :       1623 :   code = code->block->next;
    3772                 :       1623 :   gcc_assert (code->op == EXEC_ASSIGN);
    3773                 :       1623 :   var = code->expr1->symtree->n.sym;
    3774                 :            : 
    3775                 :       1623 :   gfc_init_se (&lse, NULL);
    3776                 :       1623 :   gfc_init_se (&rse, NULL);
    3777                 :       1623 :   gfc_init_se (&vse, NULL);
    3778                 :       1623 :   gfc_start_block (&block);
    3779                 :            : 
    3780                 :       1623 :   expr2 = code->expr2;
    3781                 :       1623 :   if (((atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK)
    3782                 :            :        != GFC_OMP_ATOMIC_WRITE)
    3783                 :       1267 :       && expr2->expr_type == EXPR_FUNCTION
    3784                 :        296 :       && expr2->value.function.isym
    3785                 :        296 :       && expr2->value.function.isym->id == GFC_ISYM_CONVERSION)
    3786                 :        135 :     expr2 = expr2->value.function.actual->expr;
    3787                 :            : 
    3788                 :       1623 :   switch (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK)
    3789                 :            :     {
    3790                 :        268 :     case GFC_OMP_ATOMIC_READ:
    3791                 :        268 :       gfc_conv_expr (&vse, code->expr1);
    3792                 :        268 :       gfc_add_block_to_block (&block, &vse.pre);
    3793                 :            : 
    3794                 :        268 :       gfc_conv_expr (&lse, expr2);
    3795                 :        268 :       gfc_add_block_to_block (&block, &lse.pre);
    3796                 :        268 :       type = TREE_TYPE (lse.expr);
    3797                 :        268 :       lhsaddr = gfc_build_addr_expr (NULL, lse.expr);
    3798                 :            : 
    3799                 :        268 :       x = build1 (OMP_ATOMIC_READ, type, lhsaddr);
    3800                 :        268 :       OMP_ATOMIC_MEMORY_ORDER (x) = mo;
    3801                 :        268 :       x = convert (TREE_TYPE (vse.expr), x);
    3802                 :        268 :       gfc_add_modify (&block, vse.expr, x);
    3803                 :            : 
    3804                 :        268 :       gfc_add_block_to_block (&block, &lse.pre);
    3805                 :        268 :       gfc_add_block_to_block (&block, &rse.pre);
    3806                 :            : 
    3807                 :        268 :       return gfc_finish_block (&block);
    3808                 :        387 :     case GFC_OMP_ATOMIC_CAPTURE:
    3809                 :        387 :       aop = OMP_ATOMIC_CAPTURE_NEW;
    3810                 :        387 :       if (expr2->expr_type == EXPR_VARIABLE)
    3811                 :            :         {
    3812                 :        205 :           aop = OMP_ATOMIC_CAPTURE_OLD;
    3813                 :        205 :           gfc_conv_expr (&vse, code->expr1);
    3814                 :        205 :           gfc_add_block_to_block (&block, &vse.pre);
    3815                 :            : 
    3816                 :        205 :           gfc_conv_expr (&lse, expr2);
    3817                 :        205 :           gfc_add_block_to_block (&block, &lse.pre);
    3818                 :        205 :           gfc_init_se (&lse, NULL);
    3819                 :        205 :           code = code->next;
    3820                 :        205 :           var = code->expr1->symtree->n.sym;
    3821                 :        205 :           expr2 = code->expr2;
    3822                 :        205 :           if (expr2->expr_type == EXPR_FUNCTION
    3823                 :         66 :               && expr2->value.function.isym
    3824                 :         66 :               && expr2->value.function.isym->id == GFC_ISYM_CONVERSION)
    3825                 :          6 :             expr2 = expr2->value.function.actual->expr;
    3826                 :            :         }
    3827                 :            :       break;
    3828                 :            :     default:
    3829                 :            :       break;
    3830                 :            :     }
    3831                 :            : 
    3832                 :       1355 :   gfc_conv_expr (&lse, code->expr1);
    3833                 :       1355 :   gfc_add_block_to_block (&block, &lse.pre);
    3834                 :       1355 :   type = TREE_TYPE (lse.expr);
    3835                 :       1355 :   lhsaddr = gfc_build_addr_expr (NULL, lse.expr);
    3836                 :            : 
    3837                 :       1355 :   if (((atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK)
    3838                 :            :        == GFC_OMP_ATOMIC_WRITE)
    3839                 :        999 :       || (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SWAP))
    3840                 :            :     {
    3841                 :        378 :       gfc_conv_expr (&rse, expr2);
    3842                 :        378 :       gfc_add_block_to_block (&block, &rse.pre);
    3843                 :            :     }
    3844                 :        977 :   else if (expr2->expr_type == EXPR_OP)
    3845                 :            :     {
    3846                 :        756 :       gfc_expr *e;
    3847                 :        756 :       switch (expr2->value.op.op)
    3848                 :            :         {
    3849                 :            :         case INTRINSIC_PLUS:
    3850                 :            :           op = PLUS_EXPR;
    3851                 :            :           break;
    3852                 :         81 :         case INTRINSIC_TIMES:
    3853                 :         81 :           op = MULT_EXPR;
    3854                 :         81 :           break;
    3855                 :        103 :         case INTRINSIC_MINUS:
    3856                 :        103 :           op = MINUS_EXPR;
    3857                 :        103 :           break;
    3858                 :         81 :         case INTRINSIC_DIVIDE:
    3859                 :         81 :           if (expr2->ts.type == BT_INTEGER)
    3860                 :            :             op = TRUNC_DIV_EXPR;
    3861                 :            :           else
    3862                 :         74 :             op = RDIV_EXPR;
    3863                 :            :           break;
    3864                 :         37 :         case INTRINSIC_AND:
    3865                 :         37 :           op = TRUTH_ANDIF_EXPR;
    3866                 :         37 :           break;
    3867                 :         43 :         case INTRINSIC_OR:
    3868                 :         43 :           op = TRUTH_ORIF_EXPR;
    3869                 :         43 :           break;
    3870                 :         37 :         case INTRINSIC_EQV:
    3871                 :         37 :           op = EQ_EXPR;
    3872                 :         37 :           break;
    3873                 :         37 :         case INTRINSIC_NEQV:
    3874                 :         37 :           op = NE_EXPR;
    3875                 :         37 :           break;
    3876                 :          0 :         default:
    3877                 :          0 :           gcc_unreachable ();
    3878                 :            :         }
    3879                 :        756 :       e = expr2->value.op.op1;
    3880                 :        756 :       if (e->expr_type == EXPR_FUNCTION
    3881                 :         48 :           && e->value.function.isym
    3882                 :         48 :           && e->value.function.isym->id == GFC_ISYM_CONVERSION)
    3883                 :         48 :         e = e->value.function.actual->expr;
    3884                 :        756 :       if (e->expr_type == EXPR_VARIABLE
    3885                 :        522 :           && e->symtree != NULL
    3886                 :        522 :           && e->symtree->n.sym == var)
    3887                 :            :         {
    3888                 :        516 :           expr2 = expr2->value.op.op2;
    3889                 :        516 :           var_on_left = true;
    3890                 :            :         }
    3891                 :            :       else
    3892                 :            :         {
    3893                 :        240 :           e = expr2->value.op.op2;
    3894                 :        240 :           if (e->expr_type == EXPR_FUNCTION
    3895                 :         48 :               && e->value.function.isym
    3896                 :         48 :               && e->value.function.isym->id == GFC_ISYM_CONVERSION)
    3897                 :         48 :             e = e->value.function.actual->expr;
    3898                 :        240 :           gcc_assert (e->expr_type == EXPR_VARIABLE
    3899                 :            :                       && e->symtree != NULL
    3900                 :            :                       && e->symtree->n.sym == var);
    3901                 :            :           expr2 = expr2->value.op.op1;
    3902                 :            :           var_on_left = false;
    3903                 :            :         }
    3904                 :        756 :       gfc_conv_expr (&rse, expr2);
    3905                 :        756 :       gfc_add_block_to_block (&block, &rse.pre);
    3906                 :            :     }
    3907                 :            :   else
    3908                 :            :     {
    3909                 :        221 :       gcc_assert (expr2->expr_type == EXPR_FUNCTION);
    3910                 :        221 :       switch (expr2->value.function.isym->id)
    3911                 :            :         {
    3912                 :            :         case GFC_ISYM_MIN:
    3913                 :            :           op = MIN_EXPR;
    3914                 :            :           break;
    3915                 :         55 :         case GFC_ISYM_MAX:
    3916                 :         55 :           op = MAX_EXPR;
    3917                 :         55 :           break;
    3918                 :         37 :         case GFC_ISYM_IAND:
    3919                 :         37 :           op = BIT_AND_EXPR;
    3920                 :         37 :           break;
    3921                 :         37 :         case GFC_ISYM_IOR:
    3922                 :         37 :           op = BIT_IOR_EXPR;
    3923                 :         37 :           break;
    3924                 :         37 :         case GFC_ISYM_IEOR:
    3925                 :         37 :           op = BIT_XOR_EXPR;
    3926                 :         37 :           break;
    3927                 :          0 :         default:
    3928                 :          0 :           gcc_unreachable ();
    3929                 :            :         }
    3930                 :        221 :       e = expr2->value.function.actual->expr;
    3931                 :        221 :       gcc_assert (e->expr_type == EXPR_VARIABLE
    3932                 :            :                   && e->symtree != NULL
    3933                 :            :                   && e->symtree->n.sym == var);
    3934                 :            : 
    3935                 :        221 :       gfc_conv_expr (&rse, expr2->value.function.actual->next->expr);
    3936                 :        221 :       gfc_add_block_to_block (&block, &rse.pre);
    3937                 :        221 :       if (expr2->value.function.actual->next->next != NULL)
    3938                 :            :         {
    3939                 :         26 :           tree accum = gfc_create_var (TREE_TYPE (rse.expr), NULL);
    3940                 :         26 :           gfc_actual_arglist *arg;
    3941                 :            : 
    3942                 :         26 :           gfc_add_modify (&block, accum, rse.expr);
    3943                 :         64 :           for (arg = expr2->value.function.actual->next->next; arg;
    3944                 :         38 :                arg = arg->next)
    3945                 :            :             {
    3946                 :         38 :               gfc_init_block (&rse.pre);
    3947                 :         38 :               gfc_conv_expr (&rse, arg->expr);
    3948                 :         38 :               gfc_add_block_to_block (&block, &rse.pre);
    3949                 :         38 :               x = fold_build2_loc (input_location, op, TREE_TYPE (accum),
    3950                 :            :                                    accum, rse.expr);
    3951                 :         38 :               gfc_add_modify (&block, accum, x);
    3952                 :            :             }
    3953                 :            : 
    3954                 :         26 :           rse.expr = accum;
    3955                 :            :         }
    3956                 :            : 
    3957                 :        221 :       expr2 = expr2->value.function.actual->next->expr;
    3958                 :            :     }
    3959                 :            : 
    3960                 :       1355 :   lhsaddr = save_expr (lhsaddr);
    3961                 :       1355 :   if (TREE_CODE (lhsaddr) != SAVE_EXPR
    3962                 :       1355 :       && (TREE_CODE (lhsaddr) != ADDR_EXPR
    3963                 :       1045 :           || !VAR_P (TREE_OPERAND (lhsaddr, 0))))
    3964                 :            :     {
    3965                 :            :       /* Make sure LHS is simple enough so that goa_lhs_expr_p can recognize
    3966                 :            :          it even after unsharing function body.  */
    3967                 :         38 :       tree var = create_tmp_var_raw (TREE_TYPE (lhsaddr));
    3968                 :         38 :       DECL_CONTEXT (var) = current_function_decl;
    3969                 :         38 :       lhsaddr = build4 (TARGET_EXPR, TREE_TYPE (lhsaddr), var, lhsaddr,
    3970                 :            :                         NULL_TREE, NULL_TREE);
    3971                 :            :     }
    3972                 :            : 
    3973                 :       1355 :   rhs = gfc_evaluate_now (rse.expr, &block);
    3974                 :            : 
    3975                 :       1355 :   if (((atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK)
    3976                 :            :        == GFC_OMP_ATOMIC_WRITE)
    3977                 :        999 :       || (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SWAP))
    3978                 :            :     x = rhs;
    3979                 :            :   else
    3980                 :            :     {
    3981                 :        977 :       x = convert (TREE_TYPE (rhs),
    3982                 :            :                    build_fold_indirect_ref_loc (input_location, lhsaddr));
    3983                 :        977 :       if (var_on_left)
    3984                 :        516 :         x = fold_build2_loc (input_location, op, TREE_TYPE (rhs), x, rhs);
    3985                 :            :       else
    3986                 :        461 :         x = fold_build2_loc (input_location, op, TREE_TYPE (rhs), rhs, x);
    3987                 :            :     }
    3988                 :            : 
    3989                 :       1355 :   if (TREE_CODE (TREE_TYPE (rhs)) == COMPLEX_TYPE
    3990                 :       1355 :       && TREE_CODE (type) != COMPLEX_TYPE)
    3991                 :          0 :     x = fold_build1_loc (input_location, REALPART_EXPR,
    3992                 :          0 :                          TREE_TYPE (TREE_TYPE (rhs)), x);
    3993                 :            : 
    3994                 :       1355 :   gfc_add_block_to_block (&block, &lse.pre);
    3995                 :       1355 :   gfc_add_block_to_block (&block, &rse.pre);
    3996                 :            : 
    3997                 :       1355 :   if (aop == OMP_ATOMIC)
    3998                 :            :     {
    3999                 :        968 :       x = build2_v (OMP_ATOMIC, lhsaddr, convert (type, x));
    4000                 :        968 :       OMP_ATOMIC_MEMORY_ORDER (x) = mo;
    4001                 :        968 :       gfc_add_expr_to_block (&block, x);
    4002                 :            :     }
    4003                 :            :   else
    4004                 :            :     {
    4005                 :        387 :       if (aop == OMP_ATOMIC_CAPTURE_NEW)
    4006                 :            :         {
    4007                 :        182 :           code = code->next;
    4008                 :        182 :           expr2 = code->expr2;
    4009                 :        182 :           if (expr2->expr_type == EXPR_FUNCTION
    4010                 :          2 :               && expr2->value.function.isym
    4011                 :          2 :               && expr2->value.function.isym->id == GFC_ISYM_CONVERSION)
    4012                 :          2 :             expr2 = expr2->value.function.actual->expr;
    4013                 :            : 
    4014                 :        182 :           gcc_assert (expr2->expr_type == EXPR_VARIABLE);
    4015                 :        182 :           gfc_conv_expr (&vse, code->expr1);
    4016                 :        182 :           gfc_add_block_to_block (&block, &vse.pre);
    4017                 :            : 
    4018                 :        182 :           gfc_init_se (&lse, NULL);
    4019                 :        182 :           gfc_conv_expr (&lse, expr2);
    4020                 :        182 :           gfc_add_block_to_block (&block, &lse.pre);
    4021                 :            :         }
    4022                 :        387 :       x = build2 (aop, type, lhsaddr, convert (type, x));
    4023                 :        387 :       OMP_ATOMIC_MEMORY_ORDER (x) = mo;
    4024                 :        387 :       x = convert (TREE_TYPE (vse.expr), x);
    4025                 :        387 :       gfc_add_modify (&block, vse.expr, x);
    4026                 :            :     }
    4027                 :            : 
    4028                 :       1355 :   return gfc_finish_block (&block);
    4029                 :            : }
    4030                 :            : 
    4031                 :            : static tree
    4032                 :        418 : gfc_trans_omp_barrier (void)
    4033                 :            : {
    4034                 :          0 :   tree decl = builtin_decl_explicit (BUILT_IN_GOMP_BARRIER);
    4035                 :        418 :   return build_call_expr_loc (input_location, decl, 0);
    4036                 :            : }
    4037                 :            : 
    4038                 :            : static tree
    4039                 :        134 : gfc_trans_omp_cancel (gfc_code *code)
    4040                 :            : {
    4041                 :        134 :   int mask = 0;
    4042                 :        134 :   tree ifc = boolean_true_node;
    4043                 :        134 :   stmtblock_t block;
    4044                 :        134 :   switch (code->ext.omp_clauses->cancel)
    4045                 :            :     {
    4046                 :            :     case OMP_CANCEL_PARALLEL: mask = 1; break;
    4047                 :            :     case OMP_CANCEL_DO: mask = 2; break;
    4048                 :            :     case OMP_CANCEL_SECTIONS: mask = 4; break;
    4049                 :            :     case OMP_CANCEL_TASKGROUP: mask = 8; break;
    4050                 :          0 :     default: gcc_unreachable ();
    4051                 :            :     }
    4052                 :        134 :   gfc_start_block (&block);
    4053                 :        134 :   if (code->ext.omp_clauses->if_expr)
    4054                 :            :     {
    4055                 :         84 :       gfc_se se;
    4056                 :         84 :       tree if_var;
    4057                 :            : 
    4058                 :         84 :       gfc_init_se (&se, NULL);
    4059                 :         84 :       gfc_conv_expr (&se, code->ext.omp_clauses->if_expr);
    4060                 :         84 :       gfc_add_block_to_block (&block, &se.pre);
    4061                 :         84 :       if_var = gfc_evaluate_now (se.expr, &block);
    4062                 :         84 :       gfc_add_block_to_block (&block, &se.post);
    4063                 :         84 :       tree type = TREE_TYPE (if_var);
    4064                 :         84 :       ifc = fold_build2_loc (input_location, NE_EXPR,
    4065                 :            :                              boolean_type_node, if_var,
    4066                 :            :                              build_zero_cst (type));
    4067                 :            :     }
    4068                 :        134 :   tree decl = builtin_decl_explicit (BUILT_IN_GOMP_CANCEL);
    4069                 :        134 :   tree c_bool_type = TREE_TYPE (TREE_TYPE (decl));
    4070                 :        134 :   ifc = fold_convert (c_bool_type, ifc);
    4071                 :        134 :   gfc_add_expr_to_block (&block,
    4072                 :            :                          build_call_expr_loc (input_location, decl, 2,
    4073                 :            :                                               build_int_cst (integer_type_node,
    4074                 :            :                                                              mask), ifc));
    4075                 :        134 :   return gfc_finish_block (&block);
    4076                 :            : }
    4077                 :            : 
    4078                 :            : static tree
    4079                 :         14 : gfc_trans_omp_cancellation_point (gfc_code *code)
    4080                 :            : {
    4081                 :         14 :   int mask = 0;
    4082                 :         14 :   switch (code->ext.omp_clauses->cancel)
    4083                 :            :     {
    4084                 :            :     case OMP_CANCEL_PARALLEL: mask = 1; break;
    4085                 :            :     case OMP_CANCEL_DO: mask = 2; break;
    4086                 :            :     case OMP_CANCEL_SECTIONS: mask = 4; break;
    4087                 :            :     case OMP_CANCEL_TASKGROUP: mask = 8; break;
    4088                 :          0 :     default: gcc_unreachable ();
    4089                 :            :     }
    4090                 :         14 :   tree decl = builtin_decl_explicit (BUILT_IN_GOMP_CANCELLATION_POINT);
    4091                 :         14 :   return build_call_expr_loc (input_location, decl, 1,
    4092                 :         14 :                               build_int_cst (integer_type_node, mask));
    4093                 :            : }
    4094                 :            : 
    4095                 :            : static tree
    4096                 :         54 : gfc_trans_omp_critical (gfc_code *code)
    4097                 :            : {
    4098                 :         54 :   tree name = NULL_TREE, stmt;
    4099                 :         54 :   if (code->ext.omp_clauses != NULL)
    4100                 :         23 :     name = get_identifier (code->ext.omp_clauses->critical_name);
    4101                 :         54 :   stmt = gfc_trans_code (code->block->next);
    4102                 :         54 :   return build3_loc (input_location, OMP_CRITICAL, void_type_node, stmt,
    4103                 :         54 :                      NULL_TREE, name);
    4104                 :            : }
    4105                 :            : 
    4106                 :            : typedef struct dovar_init_d {
    4107                 :            :   tree var;
    4108                 :            :   tree init;
    4109                 :            : } dovar_init;
    4110                 :            : 
    4111                 :            : 
    4112                 :            : static tree
    4113                 :       6204 : gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
    4114                 :            :                   gfc_omp_clauses *do_clauses, tree par_clauses)
    4115                 :            : {
    4116                 :       6204 :   gfc_se se;
    4117                 :       6204 :   tree dovar, stmt, from, to, step, type, init, cond, incr, orig_decls;
    4118                 :       6204 :   tree count = NULL_TREE, cycle_label, tmp, omp_clauses;
    4119                 :       6204 :   stmtblock_t block;
    4120                 :       6204 :   stmtblock_t body;
    4121                 :       6204 :   gfc_omp_clauses *clauses = code->ext.omp_clauses;
    4122                 :       6204 :   int i, collapse = clauses->collapse;
    4123                 :       6204 :   vec<dovar_init> inits = vNULL;
    4124                 :       6204 :   dovar_init *di;
    4125                 :       6204 :   unsigned ix;
    4126                 :       6204 :   vec<tree, va_heap, vl_embed> *saved_doacross_steps = doacross_steps;
    4127                 :       6204 :   gfc_expr_list *tile = do_clauses ? do_clauses->tile_list : clauses->tile_list;
    4128                 :            : 
    4129                 :            :   /* Both collapsed and tiled loops are lowered the same way.  In
    4130                 :            :      OpenACC, those clauses are not compatible, so prioritize the tile
    4131                 :            :      clause, if present.  */
    4132                 :       6204 :   if (tile)
    4133                 :            :     {
    4134                 :            :       collapse = 0;
    4135                 :        260 :       for (gfc_expr_list *el = tile; el; el = el->next)
    4136                 :        158 :         collapse++;
    4137                 :            :     }
    4138                 :            : 
    4139                 :       6204 :   doacross_steps = NULL;
    4140                 :       6204 :   if (clauses->orderedc)
    4141                 :        120 :     collapse = clauses->orderedc;
    4142                 :       6204 :   if (collapse <= 0)
    4143                 :            :     collapse = 1;
    4144                 :            : 
    4145                 :       6204 :   code = code->block->next;
    4146                 :       6204 :   gcc_assert (code->op == EXEC_DO);
    4147                 :            : 
    4148                 :       6204 :   init = make_tree_vec (collapse);
    4149                 :       6204 :   cond = make_tree_vec (collapse);
    4150                 :       6204 :   incr = make_tree_vec (collapse);
    4151                 :       6204 :   orig_decls = clauses->orderedc ? make_tree_vec (collapse) : NULL_TREE;
    4152                 :            : 
    4153                 :       6204 :   if (pblock == NULL)
    4154                 :            :     {
    4155                 :       3988 :       gfc_start_block (&block);
    4156                 :       3988 :       pblock = &block;
    4157                 :            :     }
    4158                 :            : 
    4159                 :            :   /* simd schedule modifier is only useful for composite do simd and other
    4160                 :            :      constructs including that, where gfc_trans_omp_do is only called
    4161                 :            :      on the simd construct and DO's clauses are translated elsewhere.  */
    4162                 :       6204 :   do_clauses->sched_simd = false;
    4163                 :            : 
    4164                 :       6204 :   omp_clauses = gfc_trans_omp_clauses (pblock, do_clauses, code->loc);
    4165                 :            : 
    4166                 :      13574 :   for (i = 0; i < collapse; i++)
    4167                 :            :     {
    4168                 :       7370 :       int simple = 0;
    4169                 :       7370 :       int dovar_found = 0;
    4170                 :       7370 :       tree dovar_decl;
    4171                 :            : 
    4172                 :       7370 :       if (clauses)
    4173                 :            :         {
    4174                 :       7370 :           gfc_omp_namelist *n = NULL;
    4175                 :       7370 :           if (op != EXEC_OMP_DISTRIBUTE)
    4176                 :       7346 :             for (n = clauses->lists[(op == EXEC_OMP_SIMD && collapse == 1)
    4177                 :       7346 :                                     ? OMP_LIST_LINEAR : OMP_LIST_LASTPRIVATE];
    4178                 :       8341 :                  n != NULL; n = n->next)
    4179                 :       1636 :               if (code->ext.iterator->var->symtree->n.sym == n->sym)
    4180                 :            :                 break;
    4181                 :       7346 :           if (n != NULL)
    4182                 :            :             dovar_found = 1;
    4183                 :       6729 :           else if (n == NULL && op != EXEC_OMP_SIMD)
    4184                 :       7114 :             for (n = clauses->lists[OMP_LIST_PRIVATE]; n != NULL; n = n->next)
    4185                 :       5484 :               if (code->ext.iterator->var->symtree->n.sym == n->sym)
    4186                 :            :                 break;
    4187                 :       7370 :           if (n != NULL)
    4188                 :       5220 :             dovar_found++;
    4189                 :            :         }
    4190                 :            : 
    4191                 :            :       /* Evaluate all the expressions in the iterator.  */
    4192                 :       7370 :       gfc_init_se (&se, NULL);
    4193                 :       7370 :       gfc_conv_expr_lhs (&se, code->ext.iterator->var);
    4194                 :       7370 :       gfc_add_block_to_block (pblock, &se.pre);
    4195                 :       7370 :       dovar = se.expr;
    4196                 :       7370 :       type = TREE_TYPE (dovar);
    4197                 :       7370 :       gcc_assert (TREE_CODE (type) == INTEGER_TYPE);
    4198                 :            : 
    4199                 :       7370 :       gfc_init_se (&se, NULL);
    4200                 :       7370 :       gfc_conv_expr_val (&se, code->ext.iterator->start);
    4201                 :       7370 :       gfc_add_block_to_block (pblock, &se.pre);
    4202                 :       7370 :       from = gfc_evaluate_now (se.expr, pblock);
    4203                 :            : 
    4204                 :       7370 :       gfc_init_se (&se, NULL);
    4205                 :       7370 :       gfc_conv_expr_val (&se, code->ext.iterator->end);
    4206                 :       7370 :       gfc_add_block_to_block (pblock, &se.pre);
    4207                 :       7370 :       to = gfc_evaluate_now (se.expr, pblock);
    4208                 :            : 
    4209                 :       7370 :       gfc_init_se (&se, NULL);
    4210                 :       7370 :       gfc_conv_expr_val (&se, code->ext.iterator->step);
    4211                 :       7370 :       gfc_add_block_to_block (pblock, &se.pre);
    4212                 :       7370 :       step = gfc_evaluate_now (se.expr, pblock);
    4213                 :       7370 :       dovar_decl = dovar;
    4214                 :            : 
    4215                 :            :       /* Special case simple loops.  */
    4216                 :       7370 :       if (VAR_P (dovar))
    4217                 :            :         {
    4218                 :       7352 :           if (integer_onep (step))
    4219                 :            :             simple = 1;
    4220                 :        939 :           else if (tree_int_cst_equal (step, integer_minus_one_node))
    4221                 :            :             simple = -1;
    4222                 :            :         }
    4223                 :            :       else
    4224                 :         18 :         dovar_decl
    4225                 :         18 :           = gfc_trans_omp_variable (code->ext.iterator->var->symtree->n.sym,
    4226                 :            :                                     false);
    4227                 :            : 
    4228                 :            :       /* Loop body.  */
    4229                 :         18 :       if (simple)
    4230                 :            :         {
    4231                 :       6545 :           TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, dovar, from);
    4232                 :            :           /* The condition should not be folded.  */
    4233                 :       6677 :           TREE_VEC_ELT (cond, i) = build2_loc (input_location, simple > 0
    4234                 :            :                                                ? LE_EXPR : GE_EXPR,
    4235                 :            :                                                logical_type_node, dovar, to);
    4236                 :       6545 :           TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR,
    4237                 :            :                                                     type, dovar, step);
    4238                 :       6545 :           TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location,
    4239                 :            :                                                     MODIFY_EXPR,
    4240                 :            :                                                     type, dovar,
    4241                 :       6545 :                                                     TREE_VEC_ELT (incr, i));
    4242                 :            :         }
    4243                 :            :       else
    4244                 :            :         {
    4245                 :            :           /* STEP is not 1 or -1.  Use:
    4246                 :            :              for (count = 0; count < (to + step - from) / step; count++)
    4247                 :            :                {
    4248                 :            :                  dovar = from + count * step;
    4249                 :            :                  body;
    4250                 :            :                cycle_label:;
    4251                 :            :                }  */
    4252                 :        825 :           tmp = fold_build2_loc (input_location, MINUS_EXPR, type, step, from);
    4253                 :        825 :           tmp = fold_build2_loc (input_location, PLUS_EXPR, type, to, tmp);
    4254                 :        825 :           tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR, type, tmp,
    4255                 :            :                                  step);
    4256                 :        825 :           tmp = gfc_evaluate_now (tmp, pblock);
    4257                 :        825 :           count = gfc_create_var (type, "count");
    4258                 :        825 :           TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, count,
    4259                 :            :                                              build_int_cst (type, 0));
    4260                 :            :           /* The condition should not be folded.  */
    4261                 :        825 :           TREE_VEC_ELT (cond, i) = build2_loc (input_location, LT_EXPR,
    4262                 :            :                                                logical_type_node,
    4263                 :            :                                                count, tmp);
    4264                 :        825 :           TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR,
    4265                 :            :                                                     type, count,
    4266                 :        825 :                                                     build_int_cst (type, 1));
    4267                 :        825 :           TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location,
    4268                 :            :                                                     MODIFY_EXPR, type, count,
    4269                 :        825 :                                                     TREE_VEC_ELT (incr, i));
    4270                 :            : 
    4271                 :            :           /* Initialize DOVAR.  */
    4272                 :        825 :           tmp = fold_build2_loc (input_location, MULT_EXPR, type, count, step);
    4273                 :        825 :           tmp = fold_build2_loc (input_location, PLUS_EXPR, type, from, tmp);
    4274                 :        825 :           dovar_init e = {dovar, tmp};
    4275                 :        825 :           inits.safe_push (e);
    4276                 :        825 :           if (clauses->orderedc)
    4277                 :            :             {
    4278                 :        216 :               if (doacross_steps == NULL)
    4279                 :         72 :                 vec_safe_grow_cleared (doacross_steps, clauses->orderedc);
    4280                 :        216 :               (*doacross_steps)[i] = step;
    4281                 :            :             }
    4282                 :            :         }
    4283                 :       7370 :       if (orig_decls)
    4284                 :        558 :         TREE_VEC_ELT (orig_decls, i) = dovar_decl;
    4285                 :            : 
    4286                 :       7370 :       if (dovar_found == 2
    4287                 :       7370 :           && op == EXEC_OMP_SIMD
    4288                 :        157 :           && collapse == 1
    4289                 :        157 :           && !simple)
    4290                 :            :         {
    4291                 :        157 :           for (tmp = omp_clauses; tmp; tmp = OMP_CLAUSE_CHAIN (tmp))
    4292                 :        157 :             if (OMP_CLAUSE_CODE (tmp) == OMP_CLAUSE_LINEAR
    4293                 :        157 :                 && OMP_CLAUSE_DECL (tmp) == dovar)
    4294                 :            :               {
    4295                 :         67 :                 OMP_CLAUSE_LINEAR_NO_COPYIN (tmp) = 1;
    4296                 :         67 :                 break;
    4297                 :            :               }
    4298                 :            :         }
    4299                 :       7370 :       if (!dovar_found)
    4300                 :            :         {
    4301                 :       2150 :           if (op == EXEC_OMP_SIMD)
    4302                 :            :             {
    4303                 :        520 :               if (collapse == 1)
    4304                 :            :                 {
    4305                 :        412 :                   tmp = build_omp_clause (input_location, OMP_CLAUSE_LINEAR);
    4306                 :        412 :                   OMP_CLAUSE_LINEAR_STEP (tmp) = step;
    4307                 :        412 :                   OMP_CLAUSE_LINEAR_NO_COPYIN (tmp) = 1;
    4308                 :            :                 }
    4309                 :            :               else
    4310                 :        108 :                 tmp = build_omp_clause (input_location, OMP_CLAUSE_LASTPRIVATE);
    4311                 :        520 :               if (!simple)
    4312                 :         60 :                 dovar_found = 2;
    4313                 :            :             }
    4314                 :            :           else
    4315                 :       1630 :             tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE);
    4316                 :       2150 :           OMP_CLAUSE_DECL (tmp) = dovar_decl;
    4317                 :       2150 :           omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
    4318                 :            :         }
    4319                 :       7370 :       if (dovar_found == 2)
    4320                 :            :         {
    4321                 :        701 :           tree c = NULL;
    4322                 :            : 
    4323                 :        701 :           tmp = NULL;
    4324                 :        701 :           if (!simple)
    4325                 :            :             {
    4326                 :            :               /* If dovar is lastprivate, but different counter is used,
    4327                 :            :                  dovar += step needs to be added to
    4328                 :            :                  OMP_CLAUSE_LASTPRIVATE_STMT, otherwise the copied dovar
    4329                 :            :                  will have the value on entry of the last loop, rather
    4330                 :            :                  than value after iterator increment.  */
    4331                 :        340 :               if (clauses->orderedc)
    4332                 :            :                 {
    4333                 :         60 :                   if (clauses->collapse <= 1 || i >= clauses->collapse)
    4334                 :            :                     tmp = count;
    4335                 :            :                   else
    4336                 :         36 :                     tmp = fold_build2_loc (input_location, PLUS_EXPR,
    4337                 :            :                                            type, count, build_one_cst (type));
    4338                 :         60 :                   tmp = fold_build2_loc (input_location, MULT_EXPR, type,
    4339                 :            :                                          tmp, step);
    4340                 :         60 :                   tmp = fold_build2_loc (input_location, PLUS_EXPR, type,
    4341                 :            :                                          from, tmp);
    4342                 :            :                 }
    4343                 :            :               else
    4344                 :            :                 {
    4345                 :        280 :                   tmp = gfc_evaluate_now (step, pblock);
    4346                 :        280 :                   tmp = fold_build2_loc (input_location, PLUS_EXPR, type,
    4347                 :            :                                          dovar, tmp);
    4348                 :            :                 }
    4349                 :        340 :               tmp = fold_build2_loc (input_location, MODIFY_EXPR, type,
    4350                 :            :                                      dovar, tmp);
    4351                 :        806 :               for (c = omp_clauses; c ; c = OMP_CLAUSE_CHAIN (c))
    4352                 :        710 :                 if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE
    4353                 :        710 :                     && OMP_CLAUSE_DECL (c) == dovar_decl)
    4354                 :            :                   {
    4355                 :        117 :                     OMP_CLAUSE_LASTPRIVATE_STMT (c) = tmp;
    4356                 :        117 :                     break;
    4357                 :            :                   }
    4358                 :        593 :                 else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LINEAR
    4359                 :        593 :                          && OMP_CLAUSE_DECL (c) == dovar_decl)
    4360                 :            :                   {
    4361                 :        127 :                     OMP_CLAUSE_LINEAR_STMT (c) = tmp;
    4362                 :        127 :                     break;
    4363                 :            :                   }
    4364                 :            :             }
    4365                 :        701 :           if (c == NULL && op == EXEC_OMP_DO && par_clauses != NULL)
    4366                 :            :             {
    4367                 :        354 :               for (c = par_clauses; c ; c = OMP_CLAUSE_CHAIN (c))
    4368                 :        354 :                 if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE
    4369                 :        354 :                     && OMP_CLAUSE_DECL (c) == dovar_decl)
    4370                 :            :                   {
    4371                 :        216 :                     tree l = build_omp_clause (input_location,
    4372                 :            :                                                OMP_CLAUSE_LASTPRIVATE);
    4373                 :        216 :                     OMP_CLAUSE_DECL (l) = dovar_decl;
    4374                 :        216 :                     OMP_CLAUSE_CHAIN (l) = omp_clauses;
    4375                 :        216 :                     OMP_CLAUSE_LASTPRIVATE_STMT (l) = tmp;
    4376                 :        216 :                     omp_clauses = l;
    4377                 :        216 :                     OMP_CLAUSE_SET_CODE (c, OMP_CLAUSE_SHARED);
    4378                 :        216 :                     break;
    4379                 :            :                   }
    4380                 :            :             }
    4381                 :        701 :           gcc_assert (simple || c != NULL);
    4382                 :            :         }
    4383                 :       7370 :       if (!simple)
    4384                 :            :         {
    4385                 :        825 :           if (op != EXEC_OMP_SIMD)
    4386                 :        698 :             tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE);
    4387                 :        127 :           else if (collapse == 1)
    4388                 :            :             {
    4389                 :        127 :               tmp = build_omp_clause (input_location, OMP_CLAUSE_LINEAR);
    4390                 :        127 :               OMP_CLAUSE_LINEAR_STEP (tmp) = build_int_cst (type, 1);
    4391                 :        127 :               OMP_CLAUSE_LINEAR_NO_COPYIN (tmp) = 1;
    4392                 :        127 :               OMP_CLAUSE_LINEAR_NO_COPYOUT (tmp) = 1;
    4393                 :            :             }
    4394                 :            :           else
    4395                 :          0 :             tmp = build_omp_clause (input_location, OMP_CLAUSE_LASTPRIVATE);
    4396                 :        825 :           OMP_CLAUSE_DECL (tmp) = count;
    4397                 :        825 :           omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
    4398                 :            :         }
    4399                 :            : 
    4400                 :       7370 :       if (i + 1 < collapse)
    4401                 :       1166 :         code = code->block->next;
    4402                 :            :     }
    4403                 :            : 
    4404                 :       6204 :   if (pblock != &block)
    4405                 :            :     {
    4406                 :       2216 :       pushlevel ();
    4407                 :       2216 :       gfc_start_block (&block);
    4408                 :            :     }
    4409                 :            : 
    4410                 :       6204 :   gfc_start_block (&body);
    4411                 :            : 
    4412                 :       7029 :   FOR_EACH_VEC_ELT (inits, ix, di)
    4413                 :        825 :     gfc_add_modify (&body, di->var, di->init);
    4414                 :       6204 :   inits.release ();
    4415                 :            : 
    4416                 :            :   /* Cycle statement is implemented with a goto.  Exit statement must not be
    4417                 :            :      present for this loop.  */
    4418                 :       6204 :   cycle_label = gfc_build_label_decl (NULL_TREE);
    4419                 :            : 
    4420                 :            :   /* Put these labels where they can be found later.  */
    4421                 :            : 
    4422                 :       6204 :   code->cycle_label = cycle_label;
    4423                 :       6204 :   code->exit_label = NULL_TREE;
    4424                 :            : 
    4425                 :            :   /* Main loop body.  */
    4426                 :       6204 :   tmp = gfc_trans_omp_code (code->block->next, true);
    4427                 :       6204 :   gfc_add_expr_to_block (&body, tmp);
    4428                 :            : 
    4429                 :            :   /* Label for cycle statements (if needed).  */
    4430                 :       6204 :   if (TREE_USED (cycle_label))
    4431                 :            :     {
    4432                 :       6204 :       tmp = build1_v (LABEL_EXPR, cycle_label);
    4433                 :       6204 :       gfc_add_expr_to_block (&body, tmp);
    4434                 :            :     }
    4435                 :            : 
    4436                 :            :   /* End of loop body.  */
    4437                 :       6204 :   switch (op)
    4438                 :            :     {
    4439                 :        597 :     case EXEC_OMP_SIMD: stmt = make_node (OMP_SIMD); break;
    4440                 :       1480 :     case EXEC_OMP_DO: stmt = make_node (OMP_FOR); break;
    4441                 :         20 :     case EXEC_OMP_DISTRIBUTE: stmt = make_node (OMP_DISTRIBUTE); break;
    4442                 :         19 :     case EXEC_OMP_TASKLOOP: stmt = make_node (OMP_TASKLOOP); break;
    4443                 :       4088 :     case EXEC_OACC_LOOP: stmt = make_node (OACC_LOOP); break;
    4444                 :          0 :     default: gcc_unreachable ();
    4445                 :            :     }
    4446                 :            : 
    4447                 :       6204 :   TREE_TYPE (stmt) = void_type_node;
    4448                 :      12408 :   OMP_FOR_BODY (stmt) = gfc_finish_block (&body);
    4449                 :      12408 :   OMP_FOR_CLAUSES (stmt) = omp_clauses;
    4450                 :      12408 :   OMP_FOR_INIT (stmt) = init;
    4451                 :      12408 :   OMP_FOR_COND (stmt) = cond;
    4452                 :      12408 :   OMP_FOR_INCR (stmt) = incr;
    4453                 :       6204 :   if (orig_decls)
    4454                 :        240 :     OMP_FOR_ORIG_DECLS (stmt) = orig_decls;
    4455                 :       6204 :   gfc_add_expr_to_block (&block, stmt);
    4456                 :            : 
    4457                 :       6204 :   vec_free (doacross_steps);
    4458                 :       6204 :   doacross_steps = saved_doacross_steps;
    4459                 :            : 
    4460                 :       6204 :   return gfc_finish_block (&block);
    4461                 :            : }
    4462                 :            : 
    4463                 :            : /* Translate combined OpenACC 'parallel loop', 'kernels loop', 'serial loop'
    4464                 :            :    construct. */
    4465                 :            : 
    4466                 :            : static tree
    4467                 :       1312 : gfc_trans_oacc_combined_directive (gfc_code *code)
    4468                 :            : {
    4469                 :       1312 :   stmtblock_t block, *pblock = NULL;
    4470                 :       1312 :   gfc_omp_clauses construct_clauses, loop_clauses;
    4471                 :       1312 :   tree stmt, oacc_clauses = NULL_TREE;
    4472                 :       1312 :   enum tree_code construct_code;
    4473                 :       1312 :   location_t loc = input_location;
    4474                 :            : 
    4475                 :       1312 :   switch (code->op)
    4476                 :            :     {
    4477                 :            :       case EXEC_OACC_PARALLEL_LOOP:
    4478                 :            :         construct_code = OACC_PARALLEL;
    4479                 :            :         break;
    4480                 :            :       case EXEC_OACC_KERNELS_LOOP:
    4481                 :            :         construct_code = OACC_KERNELS;
    4482                 :            :         break;
    4483                 :            :       case EXEC_OACC_SERIAL_LOOP:
    4484                 :            :         construct_code = OACC_SERIAL;
    4485                 :            :         break;
    4486                 :          0 :       default:
    4487                 :          0 :         gcc_unreachable ();
    4488                 :            :     }
    4489                 :            : 
    4490                 :       1312 :   gfc_start_block (&block);
    4491                 :            : 
    4492                 :       1312 :   memset (&loop_clauses, 0, sizeof (loop_clauses));
    4493                 :       1312 :   if (code->ext.omp_clauses != NULL)
    4494                 :            :     {
    4495                 :       1312 :       memcpy (&construct_clauses, code->ext.omp_clauses,
    4496                 :            :               sizeof (construct_clauses));
    4497                 :       1312 :       loop_clauses.collapse = construct_clauses.collapse;
    4498                 :       1312 :       loop_clauses.gang = construct_clauses.gang;
    4499                 :       1312 :       loop_clauses.gang_static = construct_clauses.gang_static;
    4500                 :       1312 :       loop_clauses.gang_num_expr = construct_clauses.gang_num_expr;
    4501                 :       1312 :       loop_clauses.gang_static_expr = construct_clauses.gang_static_expr;
    4502                 :       1312 :       loop_clauses.vector = construct_clauses.vector;
    4503                 :       1312 :       loop_clauses.vector_expr = construct_clauses.vector_expr;
    4504                 :       1312 :       loop_clauses.worker = construct_clauses.worker;
    4505                 :       1312 :       loop_clauses.worker_expr = construct_clauses.worker_expr;
    4506                 :       1312 :       loop_clauses.seq = construct_clauses.seq;
    4507                 :       1312 :       loop_clauses.par_auto = construct_clauses.par_auto;
    4508                 :       1312 :       loop_clauses.independent = construct_clauses.independent;
    4509                 :       1312 :       loop_clauses.tile_list = construct_clauses.tile_list;
    4510                 :       1312 :       loop_clauses.lists[OMP_LIST_PRIVATE]
    4511                 :       1312 :         = construct_clauses.lists[OMP_LIST_PRIVATE];
    4512                 :       1312 :       loop_clauses.lists[OMP_LIST_REDUCTION]
    4513                 :       1312 :         = construct_clauses.lists[OMP_LIST_REDUCTION];
    4514                 :       1312 :       construct_clauses.gang = false;
    4515                 :       1312 :       construct_clauses.gang_static = false;
    4516                 :       1312 :       construct_clauses.gang_num_expr = NULL;
    4517                 :       1312 :       construct_clauses.gang_static_expr = NULL;
    4518                 :       1312 :       construct_clauses.vector = false;
    4519                 :       1312 :       construct_clauses.vector_expr = NULL;
    4520                 :       1312 :       construct_clauses.worker = false;
    4521                 :       1312 :       construct_clauses.worker_expr = NULL;
    4522                 :       1312 :       construct_clauses.seq = false;
    4523                 :       1312 :       construct_clauses.par_auto = false;
    4524                 :       1312 :       construct_clauses.independent = false;
    4525                 :       1312 :       construct_clauses.independent = false;
    4526                 :       1312 :       construct_clauses.tile_list = NULL;
    4527                 :       1312 :       construct_clauses.lists[OMP_LIST_PRIVATE] = NULL;
    4528                 :       1312 :       if (construct_code == OACC_KERNELS)
    4529                 :        115 :         construct_clauses.lists[OMP_LIST_REDUCTION] = NULL;
    4530                 :       1312 :       oacc_clauses = gfc_trans_omp_clauses (&block, &construct_clauses,
    4531                 :            :                                             code->loc);
    4532                 :            :     }
    4533                 :       1312 :   if (!loop_clauses.seq)
    4534                 :            :     pblock = &block;
    4535                 :            :   else
    4536                 :         31 :     pushlevel ();
    4537                 :       1312 :   stmt = gfc_trans_omp_do (code, EXEC_OACC_LOOP, pblock, &loop_clauses, NULL);
    4538                 :       1312 :   protected_set_expr_location (stmt, loc);
    4539                 :       1312 :   if (TREE_CODE (stmt) != BIND_EXPR)
    4540                 :       1312 :     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
    4541                 :            :   else
    4542                 :          0 :     poplevel (0, 0);
    4543                 :       1312 :   stmt = build2_loc (loc, construct_code, void_type_node, stmt, oacc_clauses);
    4544                 :       1312 :   gfc_add_expr_to_block (&block, stmt);
    4545                 :       1312 :   return gfc_finish_block (&block);
    4546                 :            : }
    4547                 :            : 
    4548                 :            : static tree
    4549                 :         62 : gfc_trans_omp_flush (void)
    4550                 :            : {
    4551                 :          0 :   tree decl = builtin_decl_explicit (BUILT_IN_SYNC_SYNCHRONIZE);
    4552                 :         62 :   return build_call_expr_loc (input_location, decl, 0);
    4553                 :            : }
    4554                 :            : 
    4555                 :            : static tree
    4556                 :         74 : gfc_trans_omp_master (gfc_code *code)
    4557                 :            : {
    4558                 :         74 :   tree stmt = gfc_trans_code (code->block->next);
    4559                 :         74 :   if (IS_EMPTY_STMT (stmt))
    4560                 :            :     return stmt;
    4561                 :         74 :   return build1_v (OMP_MASTER, stmt);
    4562                 :            : }
    4563                 :            : 
    4564                 :            : static tree
    4565                 :        438 : gfc_trans_omp_ordered (gfc_code *code)
    4566                 :            : {
    4567                 :        438 :   if (!flag_openmp)
    4568                 :            :     {
    4569                 :          5 :       if (!code->ext.omp_clauses->simd)
    4570                 :          3 :         return gfc_trans_code (code->block ? code->block->next : NULL);
    4571                 :          2 :       code->ext.omp_clauses->threads = 0;
    4572                 :            :     }
    4573                 :        435 :   tree omp_clauses = gfc_trans_omp_clauses (NULL, code->ext.omp_clauses,
    4574                 :            :                                             code->loc);
    4575                 :        435 :   return build2_loc (input_location, OMP_ORDERED, void_type_node,
    4576                 :        435 :                      code->block ? gfc_trans_code (code->block->next)
    4577                 :            :                      : NULL_TREE, omp_clauses);
    4578                 :            : }
    4579                 :            : 
    4580                 :            : static tree
    4581                 :       1414 : gfc_trans_omp_parallel (gfc_code *code)
    4582                 :            : {
    4583                 :       1414 :   stmtblock_t block;
    4584                 :       1414 :   tree stmt, omp_clauses;
    4585                 :            : 
    4586                 :       1414 :   gfc_start_block (&block);
    4587                 :       1414 :   omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
    4588                 :            :                                        code->loc);
    4589                 :       1414 :   pushlevel ();
    4590                 :       1414 :   stmt = gfc_trans_omp_code (code->block->next, true);
    4591                 :       1414 :   stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
    4592                 :       1414 :   stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
    4593                 :            :                      omp_clauses);
    4594                 :       1414 :   gfc_add_expr_to_block (&block, stmt);
    4595                 :       1414 :   return gfc_finish_block (&block);
    4596                 :            : }
    4597                 :            : 
    4598                 :            : enum
    4599                 :            : {
    4600                 :            :   GFC_OMP_SPLIT_SIMD,
    4601                 :            :   GFC_OMP_SPLIT_DO,
    4602                 :            :   GFC_OMP_SPLIT_PARALLEL,
    4603                 :            :   GFC_OMP_SPLIT_DISTRIBUTE,
    4604                 :            :   GFC_OMP_SPLIT_TEAMS,
    4605                 :            :   GFC_OMP_SPLIT_TARGET,
    4606                 :            :   GFC_OMP_SPLIT_TASKLOOP,
    4607                 :            :   GFC_OMP_SPLIT_NUM
    4608                 :            : };
    4609                 :            : 
    4610                 :            : enum
    4611                 :            : {
    4612                 :            :   GFC_OMP_MASK_SIMD = (1 << GFC_OMP_SPLIT_SIMD),
    4613                 :            :   GFC_OMP_MASK_DO = (1 << GFC_OMP_SPLIT_DO),
    4614                 :            :   GFC_OMP_MASK_PARALLEL = (1 << GFC_OMP_SPLIT_PARALLEL),
    4615                 :            :   GFC_OMP_MASK_DISTRIBUTE = (1 << GFC_OMP_SPLIT_DISTRIBUTE),
    4616                 :            :   GFC_OMP_MASK_TEAMS = (1 << GFC_OMP_SPLIT_TEAMS),
    4617                 :            :   GFC_OMP_MASK_TARGET = (1 << GFC_OMP_SPLIT_TARGET),
    4618                 :            :   GFC_OMP_MASK_TASKLOOP = (1 << GFC_OMP_SPLIT_TASKLOOP)
    4619                 :            : };
    4620                 :            : 
    4621                 :            : static void
    4622                 :       1443 : gfc_split_omp_clauses (gfc_code *code,
    4623                 :            :                        gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM])
    4624                 :            : {
    4625                 :       1443 :   int mask = 0, innermost = 0;
    4626                 :       1443 :   memset (clausesa, 0, GFC_OMP_SPLIT_NUM * sizeof (gfc_omp_clauses));
    4627                 :       1443 :   switch (code->op)
    4628                 :            :     {
    4629                 :            :     case EXEC_OMP_DISTRIBUTE:
    4630                 :            :       innermost = GFC_OMP_SPLIT_DISTRIBUTE;
    4631                 :            :       break;
    4632                 :         17 :     case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
    4633                 :         17 :       mask = GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO;
    4634                 :         17 :       innermost = GFC_OMP_SPLIT_DO;
    4635                 :         17 :       break;
    4636                 :         11 :     case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
    4637                 :         11 :       mask = GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_PARALLEL
    4638                 :            :              | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD;
    4639                 :         11 :       innermost = GFC_OMP_SPLIT_SIMD;
    4640                 :         11 :       break;
    4641                 :         11 :     case EXEC_OMP_DISTRIBUTE_SIMD:
    4642                 :         11 :       mask = GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD;
    4643                 :         11 :       innermost = GFC_OMP_SPLIT_SIMD;
    4644                 :         11 :       break;
    4645                 :          0 :     case EXEC_OMP_DO:
    4646                 :          0 :       innermost = GFC_OMP_SPLIT_DO;
    4647                 :          0 :       break;
    4648                 :         66 :     case EXEC_OMP_DO_SIMD:
    4649                 :         66 :       mask = GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD;
    4650                 :         66 :       innermost = GFC_OMP_SPLIT_SIMD;
    4651                 :         66 :       break;
    4652                 :          0 :     case EXEC_OMP_PARALLEL:
    4653                 :          0 :       innermost = GFC_OMP_SPLIT_PARALLEL;
    4654                 :          0 :       break;
    4655                 :        679 :     case EXEC_OMP_PARALLEL_DO:
    4656                 :        679 :       mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO;
    4657                 :        679 :       innermost = GFC_OMP_SPLIT_DO;
    4658                 :        679 :       break;
    4659                 :        151 :     case EXEC_OMP_PARALLEL_DO_SIMD:
    4660                 :        151 :       mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD;
    4661                 :        151 :       innermost = GFC_OMP_SPLIT_SIMD;
    4662                 :        151 :       break;
    4663                 :          0 :     case EXEC_OMP_SIMD:
    4664                 :          0 :       innermost = GFC_OMP_SPLIT_SIMD;
    4665                 :          0 :       break;
    4666                 :        392 :     case EXEC_OMP_TARGET:
    4667                 :        392 :       innermost = GFC_OMP_SPLIT_TARGET;
    4668                 :        392 :       break;
    4669                 :          1 :     case EXEC_OMP_TARGET_PARALLEL:
    4670                 :          1 :       mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_PARALLEL;
    4671                 :          1 :       innermost = GFC_OMP_SPLIT_PARALLEL;
    4672                 :          1 :       break;
    4673                 :          0 :     case EXEC_OMP_TARGET_PARALLEL_DO:
    4674                 :          0 :       mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO;
    4675                 :          0 :       innermost = GFC_OMP_SPLIT_DO;
    4676                 :          0 :       break;
    4677                 :          0 :     case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
    4678                 :          0 :       mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO
    4679                 :            :              | GFC_OMP_MASK_SIMD;
    4680                 :          0 :       innermost = GFC_OMP_SPLIT_SIMD;
    4681                 :          0 :       break;
    4682                 :         12 :     case EXEC_OMP_TARGET_SIMD:
    4683                 :         12 :       mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_SIMD;
    4684                 :         12 :       innermost = GFC_OMP_SPLIT_SIMD;
    4685                 :         12 :       break;
    4686                 :         36 :     case EXEC_OMP_TARGET_TEAMS:
    4687                 :         36 :       mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS;
    4688                 :         36 :       innermost = GFC_OMP_SPLIT_TEAMS;
    4689                 :         36 :       break;
    4690                 :          3 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
    4691                 :          3 :       mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS
    4692                 :            :              | GFC_OMP_MASK_DISTRIBUTE;
    4693                 :          3 :       innermost = GFC_OMP_SPLIT_DISTRIBUTE;
    4694                 :          3 :       break;
    4695                 :          6 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
    4696                 :          6 :       mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE
    4697                 :            :              | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO;
    4698                 :          6 :       innermost = GFC_OMP_SPLIT_DO;
    4699                 :          6 :       break;
    4700                 :         13 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
    4701                 :         13 :       mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE
    4702                 :            :              | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD;
    4703                 :         13 :       innermost = GFC_OMP_SPLIT_SIMD;
    4704                 :         13 :       break;
    4705                 :          3 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
    4706                 :          3 :       mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS
    4707                 :            :              | GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD;
    4708                 :          3 :       innermost = GFC_OMP_SPLIT_SIMD;
    4709                 :          3 :       break;
    4710                 :          0 :     case EXEC_OMP_TASKLOOP:
    4711                 :          0 :       innermost = GFC_OMP_SPLIT_TASKLOOP;
    4712                 :          0 :       break;
    4713                 :          5 :     case EXEC_OMP_TASKLOOP_SIMD:
    4714                 :          5 :       mask = GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD;
    4715                 :          5 :       innermost = GFC_OMP_SPLIT_SIMD;
    4716                 :          5 :       break;
    4717                 :         18 :     case EXEC_OMP_TEAMS:
    4718                 :         18 :       innermost = GFC_OMP_SPLIT_TEAMS;
    4719                 :         18 :       break;
    4720                 :          3 :     case EXEC_OMP_TEAMS_DISTRIBUTE:
    4721                 :          3 :       mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE;
    4722                 :          3 :       innermost = GFC_OMP_SPLIT_DISTRIBUTE;
    4723                 :          3 :       break;
    4724                 :          4 :     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
    4725                 :          4 :       mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE
    4726                 :            :              | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO;
    4727                 :          4 :       innermost = GFC_OMP_SPLIT_DO;
    4728                 :          4 :       break;
    4729                 :          9 :     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
    4730                 :          9 :       mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE
    4731                 :            :              | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD;
    4732                 :          9 :       innermost = GFC_OMP_SPLIT_SIMD;
    4733                 :          9 :       break;
    4734                 :            :     case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
    4735                 :            :       mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD;
    4736                 :            :       innermost = GFC_OMP_SPLIT_SIMD;
    4737                 :            :       break;
    4738                 :          0 :     default:
    4739                 :          0 :       gcc_unreachable ();
    4740                 :            :     }
    4741                 :       1440 :   if (mask == 0)
    4742                 :            :     {
    4743                 :        410 :       clausesa[innermost] = *code->ext.omp_clauses;
    4744                 :        410 :       return;
    4745                 :            :     }
    4746                 :       1033 :   if (code->ext.omp_clauses != NULL)
    4747                 :            :     {
    4748                 :       1033 :       if (mask & GFC_OMP_MASK_TARGET)
    4749                 :            :         {
    4750                 :            :           /* First the clauses that are unique to some constructs.  */
    4751                 :         74 :           clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_MAP]
    4752                 :         74 :             = code->ext.omp_clauses->lists[OMP_LIST_MAP];
    4753                 :         74 :           clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_IS_DEVICE_PTR]
    4754                 :         74 :             = code->ext.omp_clauses->lists[OMP_LIST_IS_DEVICE_PTR];
    4755                 :         74 :           clausesa[GFC_OMP_SPLIT_TARGET].device
    4756                 :         74 :             = code->ext.omp_clauses->device;
    4757                 :         74 :           clausesa[GFC_OMP_SPLIT_TARGET].defaultmap
    4758                 :         74 :             = code->ext.omp_clauses->defaultmap;
    4759                 :         74 :           clausesa[GFC_OMP_SPLIT_TARGET].if_exprs[OMP_IF_TARGET]
    4760                 :         74 :             = code->ext.omp_clauses->if_exprs[OMP_IF_TARGET];
    4761                 :            :           /* And this is copied to all.  */
    4762                 :         74 :           clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr
    4763                 :         74 :             = code->ext.omp_clauses->if_expr;
    4764                 :            :         }
    4765                 :       1033 :       if (mask & GFC_OMP_MASK_TEAMS)
    4766                 :            :         {
    4767                 :            :           /* First the clauses that are unique to some constructs.  */
    4768                 :         80 :           clausesa[GFC_OMP_SPLIT_TEAMS].num_teams
    4769                 :         80 :             = code->ext.omp_clauses->num_teams;
    4770                 :         80 :           clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit
    4771                 :         80 :             = code->ext.omp_clauses->thread_limit;
    4772                 :            :           /* Shared and default clauses are allowed on parallel, teams
    4773                 :            :              and taskloop.  */
    4774                 :         80 :           clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_SHARED]
    4775                 :         80 :             = code->ext.omp_clauses->lists[OMP_LIST_SHARED];
    4776                 :         80 :           clausesa[GFC_OMP_SPLIT_TEAMS].default_sharing
    4777                 :         80 :             = code->ext.omp_clauses->default_sharing;
    4778                 :            :         }
    4779                 :       1033 :       if (mask & GFC_OMP_MASK_DISTRIBUTE)
    4780                 :            :         {
    4781                 :            :           /* First the clauses that are unique to some constructs.  */
    4782                 :         83 :           clausesa[GFC_OMP_SPLIT_DISTRIBUTE].dist_sched_kind
    4783                 :         83 :             = code->ext.omp_clauses->dist_sched_kind;
    4784                 :         83 :           clausesa[GFC_OMP_SPLIT_DISTRIBUTE].dist_chunk_size
    4785                 :         83 :             = code->ext.omp_clauses->dist_chunk_size;
    4786                 :            :           /* Duplicate collapse.  */
    4787                 :         83 :           clausesa[GFC_OMP_SPLIT_DISTRIBUTE].collapse
    4788                 :         83 :             = code->ext.omp_clauses->collapse;
    4789                 :            :         }
    4790                 :       1033 :       if (mask & GFC_OMP_MASK_PARALLEL)
    4791                 :            :         {
    4792                 :            :           /* First the clauses that are unique to some constructs.  */
    4793                 :        891 :           clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_COPYIN]
    4794                 :        891 :             = code->ext.omp_clauses->lists[OMP_LIST_COPYIN];
    4795                 :        891 :           clausesa[GFC_OMP_SPLIT_PARALLEL].num_threads
    4796                 :        891 :             = code->ext.omp_clauses->num_threads;
    4797                 :        891 :           clausesa[GFC_OMP_SPLIT_PARALLEL].proc_bind
    4798                 :        891 :             = code->ext.omp_clauses->proc_bind;
    4799                 :            :           /* Shared and default clauses are allowed on parallel, teams
    4800                 :            :              and taskloop.  */
    4801                 :        891 :           clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_SHARED]
    4802                 :        891 :             = code->ext.omp_clauses->lists[OMP_LIST_SHARED];
    4803                 :        891 :           clausesa[GFC_OMP_SPLIT_PARALLEL].default_sharing
    4804                 :        891 :             = code->ext.omp_clauses->default_sharing;
    4805                 :        891 :           clausesa[GFC_OMP_SPLIT_PARALLEL].if_exprs[OMP_IF_PARALLEL]
    4806                 :        891 :             = code->ext.omp_clauses->if_exprs[OMP_IF_PARALLEL];
    4807                 :            :           /* And this is copied to all.  */
    4808                 :        891 :           clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr
    4809                 :        891 :             = code->ext.omp_clauses->if_expr;
    4810                 :            :         }
    4811                 :       1033 :       if (mask & GFC_OMP_MASK_DO)
    4812                 :            :         {
    4813                 :            :           /* First the clauses that are unique to some constructs.  */
    4814                 :        956 :           clausesa[GFC_OMP_SPLIT_DO].ordered
    4815                 :        956 :             = code->ext.omp_clauses->ordered;
    4816                 :        956 :           clausesa[GFC_OMP_SPLIT_DO].orderedc
    4817                 :        956 :             = code->ext.omp_clauses->orderedc;
    4818                 :        956 :           clausesa[GFC_OMP_SPLIT_DO].sched_kind
    4819                 :        956 :             = code->ext.omp_clauses->sched_kind;
    4820                 :        956 :           if (innermost == GFC_OMP_SPLIT_SIMD)
    4821                 :        250 :             clausesa[GFC_OMP_SPLIT_DO].sched_simd
    4822                 :        250 :               = code->ext.omp_clauses->sched_simd;
    4823                 :        956 :           clausesa[GFC_OMP_SPLIT_DO].sched_monotonic
    4824                 :        956 :             = code->ext.omp_clauses->sched_monotonic;
    4825                 :        956 :           clausesa[GFC_OMP_SPLIT_DO].sched_nonmonotonic
    4826                 :        956 :             = code->ext.omp_clauses->sched_nonmonotonic;
    4827                 :        956 :           clausesa[GFC_OMP_SPLIT_DO].chunk_size
    4828                 :        956 :             = code->ext.omp_clauses->chunk_size;
    4829                 :        956 :           clausesa[GFC_OMP_SPLIT_DO].nowait
    4830                 :        956 :             = code->ext.omp_clauses->nowait;
    4831                 :            :           /* Duplicate collapse.  */
    4832                 :        956 :           clausesa[GFC_OMP_SPLIT_DO].collapse
    4833                 :        956 :             = code->ext.omp_clauses->collapse;
    4834                 :            :         }
    4835                 :       1033 :       if (mask & GFC_OMP_MASK_SIMD)
    4836                 :            :         {
    4837                 :        284 :           clausesa[GFC_OMP_SPLIT_SIMD].safelen_expr
    4838                 :        284 :             = code->ext.omp_clauses->safelen_expr;
    4839                 :        284 :           clausesa[GFC_OMP_SPLIT_SIMD].simdlen_expr
    4840                 :        284 :             = code->ext.omp_clauses->simdlen_expr;
    4841                 :        284 :           clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_ALIGNED]
    4842                 :        284 :             = code->ext.omp_clauses->lists[OMP_LIST_ALIGNED];
    4843                 :            :           /* Duplicate collapse.  */
    4844                 :        284 :           clausesa[GFC_OMP_SPLIT_SIMD].collapse
    4845                 :        284 :             = code->ext.omp_clauses->collapse;
    4846                 :            :         }
    4847                 :       1033 :       if (mask & GFC_OMP_MASK_TASKLOOP)
    4848                 :            :         {
    4849                 :            :           /* First the clauses that are unique to some constructs.  */
    4850                 :          5 :           clausesa[GFC_OMP_SPLIT_TASKLOOP].nogroup
    4851                 :          5 :             = code->ext.omp_clauses->nogroup;
    4852                 :          5 :           clausesa[GFC_OMP_SPLIT_TASKLOOP].grainsize
    4853                 :          5 :             = code->ext.omp_clauses->grainsize;
    4854                 :          5 :           clausesa[GFC_OMP_SPLIT_TASKLOOP].num_tasks
    4855                 :          5 :             = code->ext.omp_clauses->num_tasks;
    4856                 :          5 :           clausesa[GFC_OMP_SPLIT_TASKLOOP].priority
    4857                 :          5 :             = code->ext.omp_clauses->priority;
    4858                 :          5 :           clausesa[GFC_OMP_SPLIT_TASKLOOP].final_expr
    4859                 :          5 :             = code->ext.omp_clauses->final_expr;
    4860                 :          5 :           clausesa[GFC_OMP_SPLIT_TASKLOOP].untied
    4861                 :          5 :             = code->ext.omp_clauses->untied;
    4862                 :          5 :           clausesa[GFC_OMP_SPLIT_TASKLOOP].mergeable
    4863                 :          5 :             = code->ext.omp_clauses->mergeable;
    4864                 :          5 :           clausesa[GFC_OMP_SPLIT_TASKLOOP].if_exprs[OMP_IF_TASKLOOP]
    4865                 :          5 :             = code->ext.omp_clauses->if_exprs[OMP_IF_TASKLOOP];
    4866                 :            :           /* And this is copied to all.  */
    4867                 :          5 :           clausesa[GFC_OMP_SPLIT_TASKLOOP].if_expr
    4868                 :          5 :             = code->ext.omp_clauses->if_expr;
    4869                 :            :           /* Shared and default clauses are allowed on parallel, teams
    4870                 :            :              and taskloop.  */
    4871                 :          5 :           clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_SHARED]
    4872                 :          5 :             = code->ext.omp_clauses->lists[OMP_LIST_SHARED];
    4873                 :          5 :           clausesa[GFC_OMP_SPLIT_TASKLOOP].default_sharing
    4874                 :          5 :             = code->ext.omp_clauses->default_sharing;
    4875                 :            :           /* Duplicate collapse.  */
    4876                 :          5 :           clausesa[GFC_OMP_SPLIT_TASKLOOP].collapse
    4877                 :          5 :             = code->ext.omp_clauses->collapse;
    4878                 :            :         }
    4879                 :            :       /* Private clause is supported on all constructs,
    4880                 :            :          it is enough to put it on the innermost one.  For
    4881                 :            :          !$ omp parallel do put it on parallel though,
    4882                 :            :          as that's what we did for OpenMP 3.1.  */
    4883                 :       1033 :       clausesa[innermost == GFC_OMP_SPLIT_DO
    4884                 :        327 :                ? (int) GFC_OMP_SPLIT_PARALLEL
    4885                 :       1033 :                : innermost].lists[OMP_LIST_PRIVATE]
    4886                 :       1033 :         = code->ext.omp_clauses->lists[OMP_LIST_PRIVATE];
    4887                 :            :       /* Firstprivate clause is supported on all constructs but
    4888                 :            :          simd.  Put it on the outermost of those and duplicate
    4889                 :            :          on parallel and teams.  */
    4890                 :       1033 :       if (mask & GFC_OMP_MASK_TARGET)
    4891                 :         74 :         clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_FIRSTPRIVATE]
    4892                 :         74 :           = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
    4893                 :       1033 :       if (mask & GFC_OMP_MASK_TEAMS)
    4894                 :         80 :         clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_FIRSTPRIVATE]
    4895                 :         80 :           = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
    4896                 :        953 :       else if (mask & GFC_OMP_MASK_DISTRIBUTE)
    4897                 :         39 :         clausesa[GFC_OMP_SPLIT_DISTRIBUTE].lists[OMP_LIST_FIRSTPRIVATE]
    4898                 :         39 :           = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
    4899                 :       1033 :       if (mask & GFC_OMP_MASK_PARALLEL)
    4900                 :        891 :         clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_FIRSTPRIVATE]
    4901                 :        891 :           = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
    4902                 :        142 :       else if (mask & GFC_OMP_MASK_DO)
    4903                 :         66 :         clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_FIRSTPRIVATE]
    4904                 :         66 :           = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
    4905                 :            :       /* Lastprivate is allowed on distribute, do and simd.
    4906                 :            :          In parallel do{, simd} we actually want to put it on
    4907                 :            :          parallel rather than do.  */
    4908                 :       1033 :       if (mask & GFC_OMP_MASK_DISTRIBUTE)
    4909                 :         83 :         clausesa[GFC_OMP_SPLIT_DISTRIBUTE].lists[OMP_LIST_LASTPRIVATE]
    4910                 :         83 :           = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
    4911                 :       1033 :       if (mask & GFC_OMP_MASK_PARALLEL)
    4912                 :        891 :         clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_LASTPRIVATE]
    4913                 :        891 :           = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
    4914                 :        142 :       else if (mask & GFC_OMP_MASK_DO)
    4915                 :         66 :         clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_LASTPRIVATE]
    4916                 :         66 :           = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
    4917                 :       1033 :       if (mask & GFC_OMP_MASK_SIMD)
    4918                 :        284 :         clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_LASTPRIVATE]
    4919                 :        284 :           = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
    4920                 :            :       /* Reduction is allowed on simd, do, parallel and teams.
    4921                 :            :          Duplicate it on all of them, but omit on do if
    4922                 :            :          parallel is present.  */
    4923                 :       1033 :       if (mask & GFC_OMP_MASK_TEAMS)
    4924                 :         80 :         clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_REDUCTION]
    4925                 :         80 :           = code->ext.omp_clauses->lists[OMP_LIST_REDUCTION];
    4926                 :       1033 :       if (mask & GFC_OMP_MASK_PARALLEL)
    4927                 :        891 :         clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_REDUCTION]
    4928                 :        891 :           = code->ext.omp_clauses->lists[OMP_LIST_REDUCTION];
    4929                 :        142 :       else if (mask & GFC_OMP_MASK_DO)
    4930                 :         66 :         clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_REDUCTION]
    4931                 :         66 :           = code->ext.omp_clauses->lists[OMP_LIST_REDUCTION];
    4932                 :       1033 :       if (mask & GFC_OMP_MASK_SIMD)
    4933                 :        284 :         clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_REDUCTION]
    4934                 :        284 :           = code->ext.omp_clauses->lists[OMP_LIST_REDUCTION];
    4935                 :            :       /* Linear clause is supported on do and simd,
    4936                 :            :          put it on the innermost one.  */
    4937                 :       1033 :       clausesa[innermost].lists[OMP_LIST_LINEAR]
    4938                 :       1033 :         = code->ext.omp_clauses->lists[OMP_LIST_LINEAR];
    4939                 :            :     }
    4940                 :       1033 :   if ((mask & (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO))
    4941                 :            :       == (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO))
    4942                 :        890 :     clausesa[GFC_OMP_SPLIT_DO].nowait = true;
    4943                 :            : }
    4944                 :            : 
    4945                 :            : static tree
    4946                 :        250 : gfc_trans_omp_do_simd (gfc_code *code, stmtblock_t *pblock,
    4947                 :            :                        gfc_omp_clauses *clausesa, tree omp_clauses)
    4948                 :            : {
    4949                 :        250 :   stmtblock_t block;
    4950                 :        250 :   gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
    4951                 :        250 :   tree stmt, body, omp_do_clauses = NULL_TREE;
    4952                 :            : 
    4953                 :        250 :   if (pblock == NULL)
    4954                 :        217 :     gfc_start_block (&block);
    4955                 :            :   else
    4956                 :         33 :     gfc_init_block (&block);
    4957                 :            : 
    4958                 :        250 :   if (clausesa == NULL)
    4959                 :            :     {
    4960                 :         66 :       clausesa = clausesa_buf;
    4961                 :         66 :       gfc_split_omp_clauses (code, clausesa);
    4962                 :            :     }
    4963                 :        250 :   if (flag_openmp)
    4964                 :        245 :     omp_do_clauses
    4965                 :        245 :       = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_DO], code->loc);
    4966                 :        283 :   body = gfc_trans_omp_do (code, EXEC_OMP_SIMD, pblock ? pblock : &block,
    4967                 :            :                            &clausesa[GFC_OMP_SPLIT_SIMD], omp_clauses);
    4968                 :        250 :   if (pblock == NULL)
    4969                 :            :     {
    4970                 :        217 :       if (TREE_CODE (body) != BIND_EXPR)
    4971                 :        217 :         body = build3_v (BIND_EXPR, NULL, body, poplevel (1, 0));
    4972                 :            :       else
    4973                 :          0 :         poplevel (0, 0);
    4974                 :            :     }
    4975                 :         33 :   else if (TREE_CODE (body) != BIND_EXPR)
    4976                 :         33 :     body = build3_v (BIND_EXPR, NULL, body, NULL_TREE);
    4977                 :        250 :   if (flag_openmp)
    4978                 :            :     {
    4979                 :        245 :       stmt = make_node (OMP_FOR);
    4980                 :        245 :       TREE_TYPE (stmt) = void_type_node;
    4981                 :        490 :       OMP_FOR_BODY (stmt) = body;
    4982                 :        490 :       OMP_FOR_CLAUSES (stmt) = omp_do_clauses;
    4983                 :            :     }
    4984                 :            :   else
    4985                 :            :     stmt = body;
    4986                 :        250 :   gfc_add_expr_to_block (&block, stmt);
    4987                 :        250 :   return gfc_finish_block (&block);
    4988                 :            : }
    4989                 :            : 
    4990                 :            : static tree
    4991                 :        706 : gfc_trans_omp_parallel_do (gfc_code *code, stmtblock_t *pblock,
    4992                 :            :                            gfc_omp_clauses *clausesa)
    4993                 :            : {
    4994                 :        706 :   stmtblock_t block, *new_pblock = pblock;
    4995                 :        706 :   gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
    4996                 :        706 :   tree stmt, omp_clauses = NULL_TREE;
    4997                 :            : 
    4998                 :        706 :   if (pblock == NULL)
    4999                 :        679 :     gfc_start_block (&block);
    5000                 :            :   else
    5001                 :         27 :     gfc_init_block (&block);
    5002                 :            : 
    5003                 :        706 :   if (clausesa == NULL)
    5004                 :            :     {
    5005                 :        679 :       clausesa = clausesa_buf;
    5006                 :        679 :       gfc_split_omp_clauses (code, clausesa);
    5007                 :            :     }
    5008                 :        706 :   omp_clauses
    5009                 :        706 :     = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_PARALLEL],
    5010                 :            :                              code->loc);
    5011                 :        706 :   if (pblock == NULL)
    5012                 :            :     {
    5013                 :        679 :       if (!clausesa[GFC_OMP_SPLIT_DO].ordered
    5014                 :        672 :           && clausesa[GFC_OMP_SPLIT_DO].sched_kind != OMP_SCHED_STATIC)
    5015                 :            :         new_pblock = &block;
    5016                 :            :       else
    5017                 :         55 :         pushlevel ();
    5018                 :            :     }
    5019                 :        706 :   stmt = gfc_trans_omp_do (code, EXEC_OMP_DO, new_pblock,
    5020                 :            :                            &clausesa[GFC_OMP_SPLIT_DO], omp_clauses);
    5021                 :        706 :   if (pblock == NULL)
    5022                 :            :     {
    5023                 :        679 :       if (TREE_CODE (stmt) != BIND_EXPR)
    5024                 :        657 :         stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
    5025                 :            :       else
    5026                 :         22 :         poplevel (0, 0);
    5027                 :            :     }
    5028                 :         27 :   else if (TREE_CODE (stmt) != BIND_EXPR)
    5029                 :         27 :     stmt = build3_v (BIND_EXPR, NULL, stmt, NULL_TREE);
    5030                 :        706 :   stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
    5031                 :            :                      omp_clauses);
    5032                 :        706 :   OMP_PARALLEL_COMBINED (stmt) = 1;
    5033                 :        706 :   gfc_add_expr_to_block (&block, stmt);
    5034                 :        706 :   return gfc_finish_block (&block);
    5035                 :            : }
    5036                 :            : 
    5037                 :            : static tree
    5038                 :        184 : gfc_trans_omp_parallel_do_simd (gfc_code *code, stmtblock_t *pblock,
    5039                 :            :                                 gfc_omp_clauses *clausesa)
    5040                 :            : {
    5041                 :        184 :   stmtblock_t block;
    5042                 :        184 :   gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
    5043                 :        184 :   tree stmt, omp_clauses = NULL_TREE;
    5044                 :            : 
    5045                 :        184 :   if (pblock == NULL)
    5046                 :        151 :     gfc_start_block (&block);
    5047                 :            :   else
    5048                 :         33 :     gfc_init_block (&block);
    5049                 :            : 
    5050                 :        184 :   if (clausesa == NULL)
    5051                 :            :     {
    5052                 :        151 :       clausesa = clausesa_buf;
    5053                 :        151 :       gfc_split_omp_clauses (code, clausesa);
    5054                 :            :     }
    5055                 :        184 :   if (flag_openmp)
    5056                 :        181 :     omp_clauses
    5057                 :        181 :       = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_PARALLEL],
    5058                 :            :                                code->loc);
    5059                 :        184 :   if (pblock == NULL)
    5060                 :        151 :     pushlevel ();
    5061                 :        184 :   stmt = gfc_trans_omp_do_simd (code, pblock, clausesa, omp_clauses);
    5062                 :        184 :   if (pblock == NULL)
    5063                 :            :     {
    5064                 :        151 :       if (TREE_CODE (stmt) != BIND_EXPR)
    5065                 :         64 :         stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
    5066                 :            :       else
    5067                 :         87 :         poplevel (0, 0);
    5068                 :            :     }
    5069                 :         33 :   else if (TREE_CODE (stmt) != BIND_EXPR)
    5070                 :         33 :     stmt = build3_v (BIND_EXPR, NULL, stmt, NULL_TREE);
    5071                 :        184 :   if (flag_openmp)
    5072                 :            :     {
    5073                 :        181 :       stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
    5074                 :            :                          omp_clauses);
    5075                 :        181 :       OMP_PARALLEL_COMBINED (stmt) = 1;
    5076                 :            :     }
    5077                 :        184 :   gfc_add_expr_to_block (&block, stmt);
    5078                 :        184 :   return gfc_finish_block (&block);
    5079                 :            : }
    5080                 :            : 
    5081                 :            : static tree
    5082                 :         45 : gfc_trans_omp_parallel_sections (gfc_code *code)
    5083                 :            : {
    5084                 :         45 :   stmtblock_t block;
    5085                 :         45 :   gfc_omp_clauses section_clauses;
    5086                 :         45 :   tree stmt, omp_clauses;
    5087                 :            : 
    5088                 :         45 :   memset (&section_clauses, 0, sizeof (section_clauses));
    5089                 :         45 :   section_clauses.nowait = true;
    5090                 :            : 
    5091                 :         45 :   gfc_start_block (&block);
    5092                 :         45 :   omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
    5093                 :            :                                        code->loc);
    5094                 :         45 :   pushlevel ();
    5095                 :         45 :   stmt = gfc_trans_omp_sections (code, &section_clauses);
    5096                 :         45 :   if (TREE_CODE (stmt) != BIND_EXPR)
    5097                 :         45 :     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
    5098                 :            :   else
    5099                 :          0 :     poplevel (0, 0);
    5100                 :         45 :   stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
    5101                 :            :                      omp_clauses);
    5102                 :         45 :   OMP_PARALLEL_COMBINED (stmt) = 1;
    5103                 :         45 :   gfc_add_expr_to_block (&block, stmt);
    5104                 :         45 :   return gfc_finish_block (&block);
    5105                 :            : }
    5106                 :            : 
    5107                 :            : static tree
    5108                 :         46 : gfc_trans_omp_parallel_workshare (gfc_code *code)
    5109                 :            : {
    5110                 :         46 :   stmtblock_t block;
    5111                 :         46 :   gfc_omp_clauses workshare_clauses;
    5112                 :         46 :   tree stmt, omp_clauses;
    5113                 :            : 
    5114                 :         46 :   memset (&workshare_clauses, 0, sizeof (workshare_clauses));
    5115                 :         46 :   workshare_clauses.nowait = true;
    5116                 :            : 
    5117                 :         46 :   gfc_start_block (&block);
    5118                 :         46 :   omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
    5119                 :            :                                        code->loc);
    5120                 :         46 :   pushlevel ();
    5121                 :         46 :   stmt = gfc_trans_omp_workshare (code, &workshare_clauses);
    5122                 :         46 :   stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
    5123                 :         46 :   stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
    5124                 :            :                      omp_clauses);
    5125                 :         46 :   OMP_PARALLEL_COMBINED (stmt) = 1;
    5126                 :         46 :   gfc_add_expr_to_block (&block, stmt);
    5127                 :         46 :   return gfc_finish_block (&block);
    5128                 :            : }
    5129                 :            : 
    5130                 :            : static tree
    5131                 :         73 : gfc_trans_omp_sections (gfc_code *code, gfc_omp_clauses *clauses)
    5132                 :            : {
    5133                 :         73 :   stmtblock_t block, body;
    5134                 :         73 :   tree omp_clauses, stmt;
    5135                 :         73 :   bool has_lastprivate = clauses->lists[OMP_LIST_LASTPRIVATE] != NULL;
    5136                 :            : 
    5137                 :         73 :   gfc_start_block (&block);
    5138                 :            : 
    5139                 :         73 :   omp_clauses = gfc_trans_omp_clauses (&block, clauses, code->loc);
    5140                 :            : 
    5141                 :         73 :   gfc_init_block (&body);
    5142                 :        326 :   for (code = code->block; code; code = code->block)
    5143                 :            :     {
    5144                 :            :       /* Last section is special because of lastprivate, so even if it
    5145                 :            :          is empty, chain it in.  */
    5146                 :        253 :       stmt = gfc_trans_omp_code (code->next,
    5147                 :        253 :                                  has_lastprivate && code->block == NULL);
    5148                 :        318 :       if (! IS_EMPTY_STMT (stmt))
    5149                 :            :         {
    5150                 :        188 :           stmt = build1_v (OMP_SECTION, stmt);
    5151                 :        188 :           gfc_add_expr_to_block (&body, stmt);
    5152                 :            :         }
    5153                 :            :     }
    5154                 :         73 :   stmt = gfc_finish_block (&body);
    5155                 :            : 
    5156                 :         73 :   stmt = build2_loc (input_location, OMP_SECTIONS, void_type_node, stmt,
    5157                 :            :                      omp_clauses);
    5158                 :         73 :   gfc_add_expr_to_block (&block, stmt);
    5159                 :            : 
    5160                 :         73 :   return gfc_finish_block (&block);
    5161                 :            : }
    5162                 :            : 
    5163                 :            : static tree
    5164                 :        443 : gfc_trans_omp_single (gfc_code *code, gfc_omp_clauses *clauses)
    5165                 :            : {
    5166                 :        443 :   tree omp_clauses = gfc_trans_omp_clauses (NULL, clauses, code->loc);
    5167                 :        443 :   tree stmt = gfc_trans_omp_code (code->block->next, true);
    5168                 :        443 :   stmt = build2_loc (input_location, OMP_SINGLE, void_type_node, stmt,
    5169                 :            :                      omp_clauses);
    5170                 :        443 :   return stmt;
    5171                 :            : }
    5172                 :            : 
    5173                 :            : static tree
    5174                 :        512 : gfc_trans_omp_task (gfc_code *code)
    5175                 :            : {
    5176                 :        512 :   stmtblock_t block;
    5177                 :        512 :   tree stmt, omp_clauses;
    5178                 :            : 
    5179                 :        512 :   gfc_start_block (&block);
    5180                 :        512 :   omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
    5181                 :            :                                        code->loc);
    5182                 :        512 :   pushlevel ();
    5183                 :        512 :   stmt = gfc_trans_omp_code (code->block->next, true);
    5184                 :        512 :   stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
    5185                 :        512 :   stmt = build2_loc (input_location, OMP_TASK, void_type_node, stmt,
    5186                 :            :                      omp_clauses);
    5187                 :        512 :   gfc_add_expr_to_block (&block, stmt);
    5188                 :        512 :   return gfc_finish_block (&block);
    5189                 :            : }
    5190                 :            : 
    5191                 :            : static tree
    5192                 :         92 : gfc_trans_omp_taskgroup (gfc_code *code)
    5193                 :            : {
    5194                 :         92 :   tree body = gfc_trans_code (code->block->next);
    5195                 :         92 :   tree stmt = make_node (OMP_TASKGROUP);
    5196                 :         92 :   TREE_TYPE (stmt) = void_type_node;
    5197                 :         92 :   OMP_TASKGROUP_BODY (stmt) = body;
    5198                 :         92 :   OMP_TASKGROUP_CLAUSES (stmt) = NULL_TREE;
    5199                 :         92 :   return stmt;
    5200                 :            : }
    5201                 :            : 
    5202                 :            : static tree
    5203                 :         72 : gfc_trans_omp_taskwait (void)
    5204                 :            : {
    5205                 :          0 :   tree decl = builtin_decl_explicit (BUILT_IN_GOMP_TASKWAIT);
    5206                 :         72 :   return build_call_expr_loc (input_location, decl, 0);
    5207                 :            : }
    5208                 :            : 
    5209                 :            : static tree
    5210                 :          8 : gfc_trans_omp_taskyield (void)
    5211                 :            : {
    5212                 :          0 :   tree decl = builtin_decl_explicit (BUILT_IN_GOMP_TASKYIELD);
    5213                 :          8 :   return build_call_expr_loc (input_location, decl, 0);
    5214                 :            : }
    5215                 :            : 
    5216                 :            : static tree
    5217                 :         77 : gfc_trans_omp_distribute (gfc_code *code, gfc_omp_clauses *clausesa)
    5218                 :            : {
    5219                 :         77 :   stmtblock_t block;
    5220                 :         77 :   gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
    5221                 :         77 :   tree stmt, omp_clauses = NULL_TREE;
    5222                 :            : 
    5223                 :         77 :   gfc_start_block (&block);
    5224                 :         77 :   if (clausesa == NULL)
    5225                 :            :     {
    5226                 :         39 :       clausesa = clausesa_buf;
    5227                 :         39 :       gfc_split_omp_clauses (code, clausesa);
    5228                 :            :     }
    5229                 :         77 :   if (flag_openmp)
    5230                 :         77 :     omp_clauses
    5231                 :         77 :       = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_DISTRIBUTE],
    5232                 :            :                                code->loc);
    5233                 :         77 :   switch (code->op)
    5234                 :            :     {
    5235                 :          0 :     case EXEC_OMP_DISTRIBUTE:
    5236                 :          0 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
    5237                 :          0 :     case EXEC_OMP_TEAMS_DISTRIBUTE:
    5238                 :            :       /* This is handled in gfc_trans_omp_do.  */
    5239                 :          0 :       gcc_unreachable ();
    5240                 :         27 :       break;
    5241                 :         27 :     case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
    5242                 :         27 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
    5243                 :         27 :     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
    5244                 :         27 :       stmt = gfc_trans_omp_parallel_do (code, &block, clausesa);
    5245                 :         27 :       if (TREE_CODE (stmt) != BIND_EXPR)
    5246                 :         27 :         stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
    5247                 :            :       else
    5248                 :          0 :         poplevel (0, 0);
    5249                 :            :       break;
    5250                 :         33 :     case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
    5251                 :         33 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
    5252                 :         33 :     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
    5253                 :         33 :       stmt = gfc_trans_omp_parallel_do_simd (code, &block, clausesa);
    5254                 :         33 :       if (TREE_CODE (stmt) != BIND_EXPR)
    5255                 :         33 :         stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
    5256                 :            :       else
    5257                 :          0 :         poplevel (0, 0);
    5258                 :            :       break;
    5259                 :         17 :     case EXEC_OMP_DISTRIBUTE_SIMD:
    5260                 :         17 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
    5261                 :         17 :     case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
    5262                 :         17 :       stmt = gfc_trans_omp_do (code, EXEC_OMP_SIMD, &block,
    5263                 :            :                                &clausesa[GFC_OMP_SPLIT_SIMD], NULL_TREE);
    5264                 :         17 :       if (TREE_CODE (stmt) != BIND_EXPR)
    5265                 :         17 :         stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
    5266                 :            :       else
    5267                 :          0 :         poplevel (0, 0);
    5268                 :            :       break;
    5269                 :          0 :     default:
    5270                 :          0 :       gcc_unreachable ();
    5271                 :            :     }
    5272                 :         77 :   if (flag_openmp)
    5273                 :            :     {
    5274                 :         77 :       tree distribute = make_node (OMP_DISTRIBUTE);
    5275                 :         77 :       TREE_TYPE (distribute) = void_type_node;
    5276                 :        154 :       OMP_FOR_BODY (distribute) = stmt;
    5277                 :        154 :       OMP_FOR_CLAUSES (distribute) = omp_clauses;
    5278                 :         77 :       stmt = distribute;
    5279                 :            :     }
    5280                 :         77 :   gfc_add_expr_to_block (&block, stmt);
    5281                 :         77 :   return gfc_finish_block (&block);
    5282                 :            : }
    5283                 :            : 
    5284                 :            : static tree
    5285                 :         98 : gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa,
    5286                 :            :                      tree omp_clauses)
    5287                 :            : {
    5288                 :         98 :   stmtblock_t block;
    5289                 :         98 :   gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
    5290                 :         98 :   tree stmt;
    5291                 :         98 :   bool combined = true;
    5292                 :            : 
    5293                 :         98 :   gfc_start_block (&block);
    5294                 :         98 :   if (clausesa == NULL)
    5295                 :            :     {
    5296                 :         37 :       clausesa = clausesa_buf;
    5297                 :         37 :       gfc_split_omp_clauses (code, clausesa);
    5298                 :            :     }
    5299                 :         98 :   if (flag_openmp)
    5300                 :            :     {
    5301                 :         98 :       omp_clauses
    5302                 :         98 :         = chainon (omp_clauses,
    5303                 :            :                    gfc_trans_omp_clauses (&block,
    5304                 :            :                                           &clausesa[GFC_OMP_SPLIT_TEAMS],
    5305                 :            :                                           code->loc));
    5306                 :         98 :       pushlevel ();
    5307                 :            :     }
    5308                 :         98 :   switch (code->op)
    5309                 :            :     {
    5310                 :         54 :     case EXEC_OMP_TARGET_TEAMS:
    5311                 :         54 :     case EXEC_OMP_TEAMS:
    5312                 :         54 :       stmt = gfc_trans_omp_code (code->block->next, true);
    5313                 :         54 :       combined = false;
    5314                 :         54 :       break;
    5315                 :          6 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
    5316                 :          6 :     case EXEC_OMP_TEAMS_DISTRIBUTE:
    5317                 :          6 :       stmt = gfc_trans_omp_do (code, EXEC_OMP_DISTRIBUTE, NULL,
    5318                 :            :                                &clausesa[GFC_OMP_SPLIT_DISTRIBUTE],
    5319                 :            :                                NULL);
    5320                 :          6 :       break;
    5321                 :         38 :     default:
    5322                 :         38 :       stmt = gfc_trans_omp_distribute (code, clausesa);
    5323                 :         38 :       break;
    5324                 :            :     }
    5325                 :         98 :   if (flag_openmp)
    5326                 :            :     {
    5327                 :         98 :       stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
    5328                 :         98 :       stmt = build2_loc (input_location, OMP_TEAMS, void_type_node, stmt,
    5329                 :            :                          omp_clauses);
    5330                 :         98 :       if (combined)
    5331                 :         44 :         OMP_TEAMS_COMBINED (stmt) = 1;
    5332                 :            :     }
    5333                 :         98 :   gfc_add_expr_to_block (&block, stmt);
    5334                 :         98 :   return gfc_finish_block (&block);
    5335                 :            : }
    5336                 :            : 
    5337                 :            : static tree
    5338                 :        466 : gfc_trans_omp_target (gfc_code *code)
    5339                 :            : {
    5340                 :        466 :   stmtblock_t block;
    5341                 :        466 :   gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM];
    5342                 :        466 :   tree stmt, omp_clauses = NULL_TREE;
    5343                 :            : 
    5344                 :        466 :   gfc_start_block (&block);
    5345                 :        466 :   gfc_split_omp_clauses (code, clausesa);
    5346                 :        466 :   if (flag_openmp)
    5347                 :        466 :     omp_clauses
    5348                 :        466 :       = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TARGET],
    5349                 :            :                                code->loc);
    5350                 :        466 :   switch (code->op)
    5351                 :            :     {
    5352                 :        392 :     case EXEC_OMP_TARGET:
    5353                 :        392 :       pushlevel ();
    5354                 :        392 :       stmt = gfc_trans_omp_code (code->block->next, true);
    5355                 :        392 :       stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
    5356                 :        392 :       break;
    5357                 :          1 :     case EXEC_OMP_TARGET_PARALLEL:
    5358                 :          1 :       {
    5359                 :          1 :         stmtblock_t iblock;
    5360                 :            : 
    5361                 :          1 :         pushlevel ();
    5362                 :          1 :         gfc_start_block (&iblock);
    5363                 :          1 :         tree inner_clauses
    5364                 :          1 :           = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_PARALLEL],
    5365                 :            :                                    code->loc);
    5366                 :          1 :         stmt = gfc_trans_omp_code (code->block->next, true);
    5367                 :          1 :         stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
    5368                 :            :                            inner_clauses);
    5369                 :          1 :         gfc_add_expr_to_block (&iblock, stmt);
    5370                 :          1 :         stmt = gfc_finish_block (&iblock);
    5371                 :          1 :         if (TREE_CODE (stmt) != BIND_EXPR)
    5372                 :          1 :           stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
    5373                 :            :         else
    5374                 :          0 :           poplevel (0, 0);
    5375                 :            :       }
    5376                 :          1 :       break;
    5377                 :          0 :     case EXEC_OMP_TARGET_PARALLEL_DO:
    5378                 :          0 :     case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
    5379                 :          0 :       stmt = gfc_trans_omp_parallel_do (code, &block, clausesa);
    5380                 :          0 :       if (TREE_CODE (stmt) != BIND_EXPR)
    5381                 :          0 :         stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
    5382                 :            :       else
    5383                 :          0 :         poplevel (0, 0);
    5384                 :            :       break;
    5385                 :         12 :     case EXEC_OMP_TARGET_SIMD:
    5386                 :         12 :       stmt = gfc_trans_omp_do (code, EXEC_OMP_SIMD, &block,
    5387                 :            :                                &clausesa[GFC_OMP_SPLIT_SIMD], NULL_TREE);
    5388                 :         12 :       if (TREE_CODE (stmt) != BIND_EXPR)
    5389                 :         12 :         stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
    5390                 :            :       else
    5391                 :          0 :         poplevel (0, 0);
    5392                 :            :       break;
    5393                 :         61 :     default:
    5394                 :         61 :       if (flag_openmp
    5395                 :         61 :           && (clausesa[GFC_OMP_SPLIT_TEAMS].num_teams
    5396                 :         26 :               || clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit))
    5397                 :            :         {
    5398                 :         35 :           gfc_omp_clauses clausesb;
    5399                 :         35 :           tree teams_clauses;
    5400                 :            :           /* For combined !$omp target teams, the num_teams and
    5401                 :            :              thread_limit clauses are evaluated before entering the
    5402                 :            :              target construct.  */
    5403                 :         35 :           memset (&clausesb, '\0', sizeof (clausesb));
    5404                 :         35 :           clausesb.num_teams = clausesa[GFC_OMP_SPLIT_TEAMS].num_teams;
    5405                 :         35 :           clausesb.thread_limit = clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit;
    5406                 :         35 :           clausesa[GFC_OMP_SPLIT_TEAMS].num_teams = NULL;
    5407                 :         35 :           clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit = NULL;
    5408                 :         35 :           teams_clauses
    5409                 :         35 :             = gfc_trans_omp_clauses (&block, &clausesb, code->loc);
    5410                 :         35 :           pushlevel ();
    5411                 :         35 :           stmt = gfc_trans_omp_teams (code, clausesa, teams_clauses);
    5412                 :            :         }
    5413                 :            :       else
    5414                 :            :         {
    5415                 :         26 :           pushlevel ();
    5416                 :         26 :           stmt = gfc_trans_omp_teams (code, clausesa, NULL_TREE);
    5417                 :            :         }
    5418                 :         61 :       if (TREE_CODE (stmt) != BIND_EXPR)
    5419                 :         61 :         stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
    5420                 :            :       else
    5421                 :          0 :         poplevel (0, 0);
    5422                 :            :       break;
    5423                 :            :     }
    5424                 :        466 :   if (flag_openmp)
    5425                 :            :     {
    5426                 :        466 :       stmt = build2_loc (input_location, OMP_TARGET, void_type_node, stmt,
    5427                 :            :                          omp_clauses);
    5428                 :        466 :       if (code->op != EXEC_OMP_TARGET)
    5429                 :         74 :         OMP_TARGET_COMBINED (stmt) = 1;
    5430                 :            :     }
    5431                 :        466 :   gfc_add_expr_to_block (&block, stmt);
    5432                 :        466 :   return gfc_finish_block (&block);
    5433                 :            : }
    5434                 :            : 
    5435                 :            : static tree
    5436                 :          5 : gfc_trans_omp_taskloop (gfc_code *code)
    5437                 :            : {
    5438                 :          5 :   stmtblock_t block;
    5439                 :          5 :   gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM];
    5440                 :          5 :   tree stmt, omp_clauses = NULL_TREE;
    5441                 :            : 
    5442                 :          5 :   gfc_start_block (&block);
    5443                 :          5 :   gfc_split_omp_clauses (code, clausesa);
    5444                 :          5 :   if (flag_openmp)
    5445                 :          5 :     omp_clauses
    5446                 :          5 :       = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TASKLOOP],
    5447                 :            :                                code->loc);
    5448                 :          5 :   switch (code->op)
    5449                 :            :     {
    5450                 :          0 :     case EXEC_OMP_TASKLOOP:
    5451                 :            :       /* This is handled in gfc_trans_omp_do.  */
    5452                 :          0 :       gcc_unreachable ();
    5453                 :          5 :       break;
    5454                 :          5 :     case EXEC_OMP_TASKLOOP_SIMD:
    5455                 :          5 :       stmt = gfc_trans_omp_do (code, EXEC_OMP_SIMD, &block,
    5456                 :            :                                &clausesa[GFC_OMP_SPLIT_SIMD], NULL_TREE);
    5457                 :          5 :       if (TREE_CODE (stmt) != BIND_EXPR)
    5458                 :          5 :         stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
    5459                 :            :       else
    5460                 :          0 :         poplevel (0, 0);
    5461                 :          5 :       break;
    5462                 :          0 :     default:
    5463                 :          0 :       gcc_unreachable ();
    5464                 :            :     }
    5465                 :          5 :   if (flag_openmp)
    5466                 :            :     {
    5467                 :          5 :       tree taskloop = make_node (OMP_TASKLOOP);
    5468                 :          5 :       TREE_TYPE (taskloop) = void_type_node;
    5469                 :         10 :       OMP_FOR_BODY (taskloop) = stmt;
    5470                 :         10 :       OMP_FOR_CLAUSES (taskloop) = omp_clauses;
    5471                 :          5 :       stmt = taskloop;
    5472                 :            :     }
    5473                 :          5 :   gfc_add_expr_to_block (&block, stmt);
    5474                 :          5 :   return gfc_finish_block (&block);
    5475                 :            : }
    5476                 :            : 
    5477                 :            : static tree
    5478                 :       1248 : gfc_trans_omp_target_data (gfc_code *code)
    5479                 :            : {
    5480                 :       1248 :   stmtblock_t block;
    5481                 :       1248 :   tree stmt, omp_clauses;
    5482                 :            : 
    5483                 :       1248 :   gfc_start_block (&block);
    5484                 :       1248 :   omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
    5485                 :            :                                        code->loc);
    5486                 :       1248 :   stmt = gfc_trans_omp_code (code->block->next, true);
    5487                 :       1248 :   stmt = build2_loc (input_location, OMP_TARGET_DATA, void_type_node, stmt,
    5488                 :            :                      omp_clauses);
    5489                 :       1248 :   gfc_add_expr_to_block (&block, stmt);
    5490                 :       1248 :   return gfc_finish_block (&block);
    5491                 :            : }
    5492                 :            : 
    5493                 :            : static tree
    5494                 :          8 : gfc_trans_omp_target_enter_data (gfc_code *code)
    5495                 :            : {
    5496                 :          8 :   stmtblock_t block;
    5497                 :          8 :   tree stmt, omp_clauses;
    5498                 :            : 
    5499                 :          8 :   gfc_start_block (&block);
    5500                 :          8 :   omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
    5501                 :            :                                        code->loc);
    5502                 :          8 :   stmt = build1_loc (input_location, OMP_TARGET_ENTER_DATA, void_type_node,
    5503                 :            :                      omp_clauses);
    5504                 :          8 :   gfc_add_expr_to_block (&block, stmt);
    5505                 :          8 :   return gfc_finish_block (&block);
    5506                 :            : }
    5507                 :            : 
    5508                 :            : static tree
    5509                 :          0 : gfc_trans_omp_target_exit_data (gfc_code *code)
    5510                 :            : {
    5511                 :          0 :   stmtblock_t block;
    5512                 :          0 :   tree stmt, omp_clauses;
    5513                 :            : 
    5514                 :          0 :   gfc_start_block (&block);
    5515                 :          0 :   omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
    5516                 :            :                                        code->loc);
    5517                 :          0 :   stmt = build1_loc (input_location, OMP_TARGET_EXIT_DATA, void_type_node,
    5518                 :            :                      omp_clauses);
    5519                 :          0 :   gfc_add_expr_to_block (&block, stmt);
    5520                 :          0 :   return gfc_finish_block (&block);
    5521                 :            : }
    5522                 :            : 
    5523                 :            : static tree
    5524                 :       1669 : gfc_trans_omp_target_update (gfc_code *code)
    5525                 :            : {
    5526                 :       1669 :   stmtblock_t block;
    5527                 :       1669 :   tree stmt, omp_clauses;
    5528                 :            : 
    5529                 :       1669 :   gfc_start_block (&block);
    5530                 :       1669 :   omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
    5531                 :            :                                        code->loc);
    5532                 :       1669 :   stmt = build1_loc (input_location, OMP_TARGET_UPDATE, void_type_node,
    5533                 :            :                      omp_clauses);
    5534                 :       1669 :   gfc_add_expr_to_block (&block, stmt);
    5535                 :       1669 :   return gfc_finish_block (&block);
    5536                 :            : }
    5537                 :            : 
    5538                 :            : static tree
    5539                 :         76 : gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses)
    5540                 :            : {
    5541                 :         76 :   tree res, tmp, stmt;
    5542                 :         76 :   stmtblock_t block, *pblock = NULL;
    5543                 :         76 :   stmtblock_t singleblock;
    5544                 :         76 :   int saved_ompws_flags;
    5545                 :         76 :   bool singleblock_in_progress = false;
    5546                 :            :   /* True if previous gfc_code in workshare construct is not workshared.  */
    5547                 :         76 :   bool prev_singleunit;
    5548                 :            : 
    5549                 :         76 :   code = code->block->next;
    5550                 :            : 
    5551                 :         76 :   pushlevel ();
    5552                 :            : 
    5553                 :         76 :   gfc_start_block (&block);
    5554                 :         76 :   pblock = &block;
    5555                 :            : 
    5556                 :         76 :   ompws_flags = OMPWS_WORKSHARE_FLAG;
    5557                 :         76 :   prev_singleunit = false;
    5558                 :            : 
    5559                 :            :   /* Translate statements one by one to trees until we reach
    5560                 :            :      the end of the workshare construct.  Adjacent gfc_codes that
    5561                 :            :      are a single unit of work are clustered and encapsulated in a
    5562                 :            :      single OMP_SINGLE construct.  */
    5563                 :        264 :   for (; code; code = code->next)
    5564                 :            :     {
    5565                 :        188 :       if (code->here != 0)
    5566                 :            :         {
    5567                 :          0 :           res = gfc_trans_label_here (code);
    5568                 :          0 :           gfc_add_expr_to_block (pblock, res);
    5569                 :            :         }
    5570                 :            : 
    5571                 :            :       /* No dependence analysis, use for clauses with wait.
    5572                 :            :          If this is the last gfc_code, use default omp_clauses.  */
    5573                 :        188 :       if (code->next == NULL && clauses->nowait)
    5574                 :         54 :         ompws_flags |= OMPWS_NOWAIT;
    5575                 :            : 
    5576                 :            :       /* By default, every gfc_code is a single unit of work.  */
    5577                 :        188 :       ompws_flags |= OMPWS_CURR_SINGLEUNIT;
    5578                 :        188 :       ompws_flags &= ~(OMPWS_SCALARIZER_WS | OMPWS_SCALARIZER_BODY);
    5579                 :            : 
    5580                 :        188 :       switch (code->op)
    5581                 :            :         {
    5582                 :            :         case EXEC_NOP:
    5583                 :            :           res = NULL_TREE;
    5584                 :            :           break;
    5585                 :            : 
    5586                 :        121 :         case EXEC_ASSIGN:
    5587                 :        121 :           res = gfc_trans_assign (code);
    5588                 :        121 :           break;
    5589                 :            : 
    5590                 :          0 :         case EXEC_POINTER_ASSIGN:
    5591                 :          0 :           res = gfc_trans_pointer_assign (code);
    5592                 :          0 :           break;
    5593                 :            : 
    5594                 :          0 :         case EXEC_INIT_ASSIGN:
    5595                 :          0 :           res = gfc_trans_init_assign (code);
    5596                 :          0 :           break;
    5597                 :            : 
    5598                 :         24 :         case EXEC_FORALL:
    5599                 :         24 :           res = gfc_trans_forall (code);
    5600                 :         24 :           break;
    5601                 :            : 
    5602                 :         19 :         case EXEC_WHERE:
    5603                 :         19 :           res = gfc_trans_where (code);
    5604                 :         19 :           break;
    5605                 :            : 
    5606                 :          7 :         case EXEC_OMP_ATOMIC:
    5607                 :          7 :           res = gfc_trans_omp_directive (code);
    5608                 :          7 :           break;
    5609                 :            : 
    5610                 :         17 :         case EXEC_OMP_PARALLEL:
    5611                 :         17 :         case EXEC_OMP_PARALLEL_DO:
    5612                 :         17 :         case EXEC_OMP_PARALLEL_SECTIONS:
    5613                 :         17 :         case EXEC_OMP_PARALLEL_WORKSHARE:
    5614                 :         17 :         case EXEC_OMP_CRITICAL:
    5615                 :         17 :           saved_ompws_flags = ompws_flags;
    5616                 :         17 :           ompws_flags = 0;
    5617                 :         17 :           res = gfc_trans_omp_directive (code);
    5618                 :         17 :           ompws_flags = saved_ompws_flags;
    5619                 :         17 :           break;
    5620                 :            :         
    5621                 :          0 :         default:
    5622                 :          0 :           gfc_internal_error ("gfc_trans_omp_workshare(): Bad statement code");
    5623                 :            :         }
    5624                 :            : 
    5625                 :        188 :       gfc_set_backend_locus (&code->loc);
    5626                 :            : 
    5627                 :        206 :       if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
    5628                 :            :         {
    5629                 :        188 :           if (prev_singleunit)
    5630                 :            :             {
    5631                 :         72 :               if (ompws_flags & OMPWS_CURR_SINGLEUNIT)
    5632                 :            :                 /* Add current gfc_code to single block.  */
    5633                 :         44 :                 gfc_add_expr_to_block (&singleblock, res);
    5634                 :            :               else
    5635                 :            :                 {
    5636                 :            :                   /* Finish single block and add it to pblock.  */
    5637                 :         28 :                   tmp = gfc_finish_block (&singleblock);
    5638                 :         28 :                   tmp = build2_loc (input_location, OMP_SINGLE,
    5639                 :            :                                     void_type_node, tmp, NULL_TREE);
    5640                 :         28 :                   gfc_add_expr_to_block (pblock, tmp);
    5641                 :            :                   /* Add current gfc_code to pblock.  */
    5642                 :         28 :                   gfc_add_expr_to_block (pblock, res);
    5643                 :         28 :                   singleblock_in_progress = false;
    5644                 :            :                 }
    5645                 :            :             }
    5646                 :            :           else
    5647                 :            :             {
    5648                 :        116 :               if (ompws_flags & OMPWS_CURR_SINGLEUNIT)
    5649                 :            :                 {
    5650                 :            :                   /* Start single block.  */
    5651                 :         68 :                   gfc_init_block (&singleblock);
    5652                 :         68 :                   gfc_add_expr_to_block (&singleblock, res);
    5653                 :         68 :                   singleblock_in_progress = true;
    5654                 :            :                 }
    5655                 :            :               else
    5656                 :            :                 /* Add the new statement to the block.  */
    5657                 :         48 :                 gfc_add_expr_to_block (pblock, res);
    5658                 :            :             }
    5659                 :        188 :           prev_singleunit = (ompws_flags & OMPWS_CURR_SINGLEUNIT) != 0;
    5660                 :            :         }
    5661                 :            :     }
    5662                 :            : 
    5663                 :            :   /* Finish remaining SINGLE block, if we were in the middle of one.  */
    5664                 :         76 :   if (singleblock_in_progress)
    5665                 :            :     {
    5666                 :            :       /* Finish single block and add it to pblock.  */
    5667                 :         40 :       tmp = gfc_finish_block (&singleblock);
    5668                 :         40 :       tmp = build2_loc (input_location, OMP_SINGLE, void_type_node, tmp,
    5669                 :         40 :                         clauses->nowait
    5670                 :         25 :                         ? build_omp_clause (input_location, OMP_CLAUSE_NOWAIT)
    5671                 :            :                         : NULL_TREE);
    5672                 :         40 :       gfc_add_expr_to_block (pblock, tmp);
    5673                 :            :     }
    5674                 :            : 
    5675                 :         76 :   stmt = gfc_finish_block (pblock);
    5676                 :         76 :   if (TREE_CODE (stmt) != BIND_EXPR)
    5677                 :            :     {
    5678                 :         60 :       if (!IS_EMPTY_STMT (stmt))
    5679                 :            :         {
    5680                 :         60 :           tree bindblock = poplevel (1, 0);
    5681                 :         60 :           stmt = build3_v (BIND_EXPR, NULL, stmt, bindblock);
    5682                 :            :         }
    5683                 :            :       else
    5684                 :          0 :         poplevel (0, 0);
    5685                 :            :     }
    5686                 :            :   else
    5687                 :         16 :     poplevel (0, 0);
    5688                 :            : 
    5689                 :         76 :   if (IS_EMPTY_STMT (stmt) && !clauses->nowait)
    5690                 :          0 :     stmt = gfc_trans_omp_barrier ();
    5691                 :            : 
    5692                 :         76 :   ompws_flags = 0;
    5693                 :         76 :   return stmt;
    5694                 :            : }
    5695                 :            : 
    5696                 :            : tree
    5697                 :         43 : gfc_trans_oacc_declare (gfc_code *code)
    5698                 :            : {
    5699                 :         43 :   stmtblock_t block;
    5700                 :         43 :   tree stmt, oacc_clauses;
    5701                 :         43 :   enum tree_code construct_code;
    5702                 :            : 
    5703                 :         43 :   construct_code = OACC_DATA;
    5704                 :            : 
    5705                 :         43 :   gfc_start_block (&block);
    5706                 :            : 
    5707                 :         43 :   oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.oacc_declare->clauses,
    5708                 :            :                                         code->loc);
    5709                 :         43 :   stmt = gfc_trans_omp_code (code->block->next, true);
    5710                 :         43 :   stmt = build2_loc (input_location, construct_code, void_type_node, stmt,
    5711                 :            :                      oacc_clauses);
    5712                 :         43 :   gfc_add_expr_to_block (&block, stmt);
    5713                 :            : 
    5714                 :         43 :   return gfc_finish_block (&block);
    5715                 :            : }
    5716                 :            : 
    5717                 :            : tree
    5718                 :       9415 : gfc_trans_oacc_directive (gfc_code *code)
    5719                 :            : {
    5720                 :       9415 :   switch (code->op)
    5721                 :            :     {
    5722                 :       1312 :     case EXEC_OACC_PARALLEL_LOOP:
    5723                 :       1312 :     case EXEC_OACC_KERNELS_LOOP:
    5724                 :       1312 :     case EXEC_OACC_SERIAL_LOOP:
    5725                 :       1312 :       return gfc_trans_oacc_combined_directive (code);
    5726                 :       3424 :     case EXEC_OACC_PARALLEL:
    5727                 :       3424 :     case EXEC_OACC_KERNELS:
    5728                 :       3424 :     case EXEC_OACC_SERIAL:
    5729                 :       3424 :     case EXEC_OACC_DATA:
    5730                 :       3424 :     case EXEC_OACC_HOST_DATA:
    5731                 :       3424 :       return gfc_trans_oacc_construct (code);
    5732                 :       2776 :     case EXEC_OACC_LOOP:
    5733                 :       2776 :       return gfc_trans_omp_do (code, code->op, NULL, code->ext.omp_clauses,
    5734                 :       2776 :                                NULL);
    5735                 :       1176 :     case EXEC_OACC_UPDATE:
    5736                 :       1176 :     case EXEC_OACC_CACHE:
    5737                 :       1176 :     case EXEC_OACC_ENTER_DATA:
    5738                 :       1176 :     case EXEC_OACC_EXIT_DATA:
    5739                 :       1176 :       return gfc_trans_oacc_executable_directive (code);
    5740                 :        167 :     case EXEC_OACC_WAIT:
    5741                 :        167 :       return gfc_trans_oacc_wait_directive (code);
    5742                 :        517 :     case EXEC_OACC_ATOMIC:
    5743                 :        517 :       return gfc_trans_omp_atomic (code);
    5744                 :         43 :     case EXEC_OACC_DECLARE:
    5745                 :         43 :       return gfc_trans_oacc_declare (code);
    5746                 :          0 :     default:
    5747                 :          0 :       gcc_unreachable ();
    5748                 :            :     }
    5749                 :            : }
    5750                 :            : 
    5751                 :            : tree
    5752                 :      10478 : gfc_trans_omp_directive (gfc_code *code)
    5753                 :            : {
    5754                 :      10478 :   switch (code->op)
    5755                 :            :     {
    5756                 :       1106 :     case EXEC_OMP_ATOMIC:
    5757                 :       1106 :       return gfc_trans_omp_atomic (code);
    5758                 :        418 :     case EXEC_OMP_BARRIER:
    5759                 :        418 :       return gfc_trans_omp_barrier ();
    5760                 :        134 :     case EXEC_OMP_CANCEL:
    5761                 :        134 :       return gfc_trans_omp_cancel (code);
    5762                 :         14 :     case EXEC_OMP_CANCELLATION_POINT:
    5763                 :         14 :       return gfc_trans_omp_cancellation_point (code);
    5764                 :         54 :     case EXEC_OMP_CRITICAL:
    5765                 :         54 :       return gfc_trans_omp_critical (code);
    5766                 :       1120 :     case EXEC_OMP_DISTRIBUTE:
    5767                 :       1120 :     case EXEC_OMP_DO:
    5768                 :       1120 :     case EXEC_OMP_SIMD:
    5769                 :       1120 :     case EXEC_OMP_TASKLOOP:
    5770                 :       1120 :       return gfc_trans_omp_do (code, code->op, NULL, code->ext.omp_clauses,
    5771                 :       1120 :                                NULL);
    5772                 :         39 :     case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
    5773                 :         39 :     case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
    5774                 :         39 :     case EXEC_OMP_DISTRIBUTE_SIMD:
    5775                 :         39 :       return gfc_trans_omp_distribute (code, NULL);
    5776                 :         66 :     case EXEC_OMP_DO_SIMD:
    5777                 :         66 :       return gfc_trans_omp_do_simd (code, NULL, NULL, NULL_TREE);
    5778                 :         62 :     case EXEC_OMP_FLUSH:
    5779                 :         62 :       return gfc_trans_omp_flush ();
    5780                 :         74 :     case EXEC_OMP_MASTER:
    5781                 :         74 :       return gfc_trans_omp_master (code);
    5782                 :        438 :     case EXEC_OMP_ORDERED:
    5783                 :        438 :       return gfc_trans_omp_ordered (code);
    5784                 :       1414 :     case EXEC_OMP_PARALLEL:
    5785                 :       1414 :       return gfc_trans_omp_parallel (code);
    5786                 :        679 :     case EXEC_OMP_PARALLEL_DO:
    5787                 :        679 :       return gfc_trans_omp_parallel_do (code, NULL, NULL);
    5788                 :        151 :     case EXEC_OMP_PARALLEL_DO_SIMD:
    5789                 :        151 :       return gfc_trans_omp_parallel_do_simd (code, NULL, NULL);
    5790                 :         45 :     case EXEC_OMP_PARALLEL_SECTIONS:
    5791                 :         45 :       return gfc_trans_omp_parallel_sections (code);
    5792                 :         46 :     case EXEC_OMP_PARALLEL_WORKSHARE:
    5793                 :         46 :       return gfc_trans_omp_parallel_workshare (code);
    5794                 :         28 :     case EXEC_OMP_SECTIONS:
    5795                 :         28 :       return gfc_trans_omp_sections (code, code->ext.omp_clauses);
    5796                 :        443 :     case EXEC_OMP_SINGLE:
    5797                 :        443 :       return gfc_trans_omp_single (code, code->ext.omp_clauses);
    5798                 :        466 :     case EXEC_OMP_TARGET:
    5799                 :        466 :     case EXEC_OMP_TARGET_PARALLEL:
    5800                 :        466 :     case EXEC_OMP_TARGET_PARALLEL_DO:
    5801                 :        466 :     case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
    5802                 :        466 :     case EXEC_OMP_TARGET_SIMD:
    5803                 :        466 :     case EXEC_OMP_TARGET_TEAMS:
    5804                 :        466 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
    5805                 :        466 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
    5806                 :        466 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
    5807                 :        466 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
    5808                 :        466 :       return gfc_trans_omp_target (code);
    5809                 :       1248 :     case EXEC_OMP_TARGET_DATA:
    5810                 :       1248 :       return gfc_trans_omp_target_data (code);
    5811                 :          8 :     case EXEC_OMP_TARGET_ENTER_DATA:
    5812                 :          8 :       return gfc_trans_omp_target_enter_data (code);
    5813                 :          0 :     case EXEC_OMP_TARGET_EXIT_DATA:
    5814                 :          0 :       return gfc_trans_omp_target_exit_data (code);
    5815                 :       1669 :     case EXEC_OMP_TARGET_UPDATE:
    5816                 :       1669 :       return gfc_trans_omp_target_update (code);
    5817                 :        512 :     case EXEC_OMP_TASK:
    5818                 :        512 :       return gfc_trans_omp_task (code);
    5819                 :         92 :     case EXEC_OMP_TASKGROUP:
    5820                 :         92 :       return gfc_trans_omp_taskgroup (code);
    5821                 :          5 :     case EXEC_OMP_TASKLOOP_SIMD:
    5822                 :          5 :       return gfc_trans_omp_taskloop (code);
    5823                 :         72 :     case EXEC_OMP_TASKWAIT:
    5824                 :         72 :       return gfc_trans_omp_taskwait ();
    5825                 :          8 :     case EXEC_OMP_TASKYIELD:
    5826                 :          8 :       return gfc_trans_omp_taskyield ();
    5827                 :         37 :     case EXEC_OMP_TEAMS:
    5828                 :         37 :     case EXEC_OMP_TEAMS_DISTRIBUTE:
    5829                 :         37 :     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
    5830                 :         37 :     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
    5831                 :         37 :     case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
    5832                 :         37 :       return gfc_trans_omp_teams (code, NULL, NULL_TREE);
    5833                 :         30 :     case EXEC_OMP_WORKSHARE:
    5834                 :         30 :       return gfc_trans_omp_workshare (code, code->ext.omp_clauses);
    5835                 :          0 :     default:
    5836                 :          0 :       gcc_unreachable ();
    5837                 :            :     }
    5838                 :            : }
    5839                 :            : 
    5840                 :            : void
    5841                 :        102 : gfc_trans_omp_declare_simd (gfc_namespace *ns)
    5842                 :            : {
    5843                 :        102 :   if (ns->entries)
    5844                 :            :     return;
    5845                 :            : 
    5846                 :        102 :   gfc_omp_declare_simd *ods;
    5847                 :        248 :   for (ods = ns->omp_declare_simd; ods; ods = ods->next)
    5848                 :            :     {
    5849                 :        146 :       tree c = gfc_trans_omp_clauses (NULL, ods->clauses, ods->where, true);
    5850                 :        146 :       tree fndecl = ns->proc_name->backend_decl;
    5851                 :        146 :       if (c != NULL_TREE)
    5852                 :         99 :         c = tree_cons (NULL_TREE, c, NULL_TREE);
    5853                 :        146 :       c = build_tree_list (get_identifier ("omp declare simd"), c);
    5854                 :        146 :       TREE_CHAIN (c) = DECL_ATTRIBUTES (fndecl);
    5855                 :        146 :       DECL_ATTRIBUTES (fndecl) = c;
    5856                 :            :     }
    5857                 :            : }

Generated by: LCOV version 1.0

LCOV profile is generated on x86_64 machine using following configure options: configure --disable-bootstrap --enable-coverage=opt --enable-languages=c,c++,fortran,go,jit,lto --enable-host-shared. GCC test suite is run with the built compiler.